시작점은 스냅 명령이 잡히는데 마지막점 선택시 스냅이 잡히질 않습니다…고수님들 수정부탁드립니다.
(defun c:DPA (/ DrawEndArrowHead DrawStartArrowHead ActDoc CurSpc Dist ArSty Pt PtList StList Ang EndList
PtList+ PtList- oPt nPt tempPt oAng oAng+ oAng- oPt+ oPt- nPt+ nPt- cAng cAng+ cAng-
tempPt+ tempPt- ntemp+ ntemp- Pt+ Pt- PolyPtList *error* AlignX AlignY AlignZ DistX DistY DistZ)
; Draw a polyline arrow, now shown as you move the cursor
(defun *error* (msg)
;(vl-bt)
(redraw)
(prompt (strcat “n Error-> ” msg))
)
;———————————————————————————————————
(defun GetCurrentSpace (Doc / BlkCol SpaceList CurSpace ActSpace temp1)
; Returns the “block object” for the active space
; Thanks to Jeff Mishler
(if (= (getvar “cvport”) 1)
(vla-get-PaperSpace Doc)
(vla-get-ModelSpace Doc)
)
)
;———————————————————————————————————
(defun AlignX (pt1 pt2)
(list
(car pt1)
(cadr pt2)
(caddr pt2)
)
)
;———————————————————————————————————
(defun AlignY (pt1 pt2)
(list
(car pt2)
(cadr pt1)
(caddr pt2)
)
)
;———————————————————————————————————
(defun AlignZ (pt1 pt2)
(list
(car pt2)
(cadr pt2)
(caddr pt1)
)
)
;———————————————————————————————————
(defun DrawEndArrowHead (Stpt CurPt ArrHeadDist ReturnPoints / Ang -Ang tempPt Ang+ Ang- Pt+ Pt-)
(setq Ang (angle StPt CurPt))
(setq -Ang (rem (+ Ang pi) (* pi 2.0)))
(setq tempPt (polar CurPt -Ang (* ArrHeadDist 2.0)))
(setq Ang+ (rem (+ Ang (* pi 0.5)) (* pi 2.0)))
(setq Ang- (rem (+ Ang (* pi 1.5)) (* pi 2.0)))
(setq Pt+ (polar tempPt Ang+ (* ArrHeadDist 0.5)))
(setq Pt- (polar tempPt Ang- (* ArrHeadDist 0.5)))
(grvecs
(list
1 Pt+ (polar Pt+ Ang+ (* ArrHeadDist 0.5))
1 (polar Pt+ Ang+ (* ArrHeadDist 0.5)) CurPt
1 CurPt (polar Pt- Ang- (* ArrHeadDist 0.5))
1 (polar Pt- Ang- (* ArrHeadDist 0.5)) Pt-
)
)
(if ReturnPoints
(list
(polar Pt+ Ang+ (* ArrHeadDist 0.5))
CurPt
(polar Pt- Ang- (* ArrHeadDist 0.5))
)
(list Pt+ Pt-)
)
)
;——————————————————————————————————————-
(defun DrawStartArrowHead (StPt CurPt ArrHeadDist ReturnPoints / Ang -Ang tempPt Ang+ Ang- Pt+ Pt- Pt+2 Pt-2)
(setq Ang (angle CurPt StPt))
(setq -Ang (rem (+ Ang pi) (* pi 2.0)))
(setq tempPt (polar StPt -Ang (* ArrHeadDist 2.0)))
(setq Ang+ (rem (+ Ang (* pi 0.5)) (* pi 2.0)))
(setq Ang- (rem (+ Ang (* pi 1.5)) (* pi 2.0)))
(setq Pt+ (polar tempPt Ang+ (* ArrHeadDist 0.5)))
(setq Pt- (polar tempPt Ang- (* ArrHeadDist 0.5)))
(grvecs
(list
1 Pt+ (polar Pt+ Ang+ (* ArrHeadDist 0.5))
1 (polar Pt+ Ang+ (* ArrHeadDist 0.5)) StPt
1 StPt (polar Pt- Ang- (* ArrHeadDist 0.5))
1 (polar Pt- Ang- (* ArrHeadDist 0.5)) Pt-
)
)
(if ReturnPoints
(list
(polar Pt+ Ang+ (* ArrHeadDist 0.5))
StPt
(polar Pt- Ang- (* ArrHeadDist 0.5))
)
(list Pt- Pt+)
)
)
,——————————————————————————————————————-
(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(vla-EndUndoMark ActDoc)
(vla-StartUndoMark ActDoc)
(setq CurSpc (GetCurrentSpace ActDoc))
(initget “Single Double”)
(setq Dist (getdist “n Enter width [<Single>/Double arrow head]: “))
(if (= (type Dist) ‘STR)
(progn
(setq ArSty Dist)
(setq Dist (getdist “n Enter width: “))
)
(setq ArSty “Single”)
)
(setq Pt (getpoint “n Select starting point: “))
(setq PtList (list Pt))
(while
(and
PtList
Pt
ArSty
Dist
(not (prompt “r Select next point [right click to exit / Undo]: “))
(not (vl-position (car (setq tempList (grread T 0))) ‘(11 25)))
)
(cond
((equal (car tempList) 2)
(cond
((equal (cadr tempList) 15)
(setvar “orthomode” (abs (1- (getvar “orthomode”))))
)
((and (> (length PtList) 1) (vl-position (cadr tempList) ‘(85 117)))
(setq PtList (cdr PtList))
(setq PtList+ (cdr PtList+))
(setq PtList- (cdr PtList-))
(redraw)
(if (= ArSty “Double”)
(DrawStartArrowHead (last PtList) (nth (- (length PtList) 2) PtList) Dist nil)
(grdraw (car StList) (cadr StList) 1)
)
(setq EndList (DrawEndArrowHead (car PtList) (polar tempPt cAng (* Dist 2.0)) Dist nil))
(setq cnt 0)
(while (< (1+ cnt) (length PtList+))
(grdraw (nth cnt PtList+) (nth (1+ cnt) PtList+) 1)
(grdraw (nth cnt PtList-) (nth (1+ cnt) PtList-) 1)
(setq cnt (1+ cnt))
)
)
(t (print tempList))
)
)
((and (equal (length PtList) 1) (or (equal (car tempList) 5) (equal (car tempList) 3)))
(setq tempPt (cadr tempList))
(setq DistX (abs (- (car Pt) (car tempPt))))
(setq DistY (abs (- (cadr Pt) (cadr tempPt))))
(setq DistZ (abs (- (caddr Pt) (caddr tempPt))))
(if (equal (getvar “orthomode”) 1)
(setq tempPt
(cond
((and (> DistX DistY) (> DistX DistZ))
(AlignY Pt tempPt)
)
((and (> DistY DistZ) (> DistY DistX))
(AlignX Pt tempPt)
)
((and (> DistZ DistX) (> DistZ DistY))
(AlignZ Pt tempPt)
)
)
)
)
(if (and tempPt (not (equal Pt tempPt 0.0001)))
(progn
(if (= ArSty “Double”)
(setq StList (DrawStartArrowHead Pt tempPt Dist nil))
(progn
(setq Ang (angle Pt tempPt))
(setq StList
(list
(polar Pt (rem (+ Ang (* pi 0.5)) (* pi 2.0)) (* Dist 0.5))
(polar Pt (rem (+ Ang (* pi 1.5)) (* pi 2.0)) (* Dist 0.5))
)
)
)
)
(cond
((equal (car tempList) 5)
(redraw)
(if (= ArSty “Double”)
(DrawStartArrowHead Pt tempPt Dist nil)
(grdraw (car StList) (cadr StList) 1)
)
(setq EndList (DrawEndArrowHead Pt tempPt Dist nil))
(grdraw (car StList) (car EndList) 1)
(grdraw (cadr StList) (cadr EndList) 1)
)
((equal (car tempList) 3)
(setq PtList+ (cons (car StList) PtList+))
(setq PtList- (cons (cadr StList) PtList-))
(setq PtList (cons tempPt PtList))
)
)
)
)
)
((and (> (length PtList) 1) (or (equal (car tempList) 5) (equal (car tempList) 3)))
(setq oPt (cadr PtList))
(setq nPt (car PtList))
(setq tempPt (cadr tempList))
(setq DistX (abs (- (car nPt) (car tempPt))))
(setq DistY (abs (- (cadr nPt) (cadr tempPt))))
(setq DistZ (abs (- (caddr nPt) (caddr tempPt))))
(if (equal (getvar “orthomode”) 1)
(setq tempPt
(cond
((and (> DistX DistY) (> DistX DistZ))
(AlignY nPt tempPt)
)
((and (> DistY DistZ) (> DistY DistX))
(AlignX nPt tempPt)
)
((and (> DistZ DistX) (> DistZ DistY))
(AlignZ nPt tempPt)
)
)
)
)
(if (and tempPt (not (equal nPt tempPt 0.0001)))
(progn
(if (= ArSty “Double”)
(setq StList (DrawStartArrowHead (last PtList) (nth (- (length PtList) 2) PtList) Dist nil))
(progn
(setq Ang (angle (last PtList) (nth (- (length PtList) 2) PtList)))
(setq StList
(list
(polar (last PtList) (rem (+ Ang (* pi 0.5)) (* pi 2.0)) (* Dist 0.5))
(polar (last PtList) (rem (+ Ang (* pi 1.5)) (* pi 2.0)) (* Dist 0.5))
)
)
)
)
(setq oAng (angle oPt nPt))
(setq oAng+ (rem (+ oAng (* pi 0.5)) (* pi 2.0)))
(setq oAng- (rem (+ oAng (* pi 1.5)) (* pi 2.0)))
(setq oPt+ (polar oPt oAng+ (* Dist 0.5)))
(setq oPt- (polar oPt oAng- (* Dist 0.5)))
(setq nPt+ (polar nPt oAng+ (* Dist 0.5)))
(setq nPt- (polar nPt oAng- (* Dist 0.5)))
(setq cAng (angle nPt tempPt))
(setq cAng+ (rem (+ cAng (* pi 0.5)) (* pi 2.0)))
(setq cAng- (rem (+ cAng (* pi 1.5)) (* pi 2.0)))
(if (equal (car tempList) 5)
(setq tempPt (polar tempPt (rem (+ cAng pi) (* pi 2.0)) (* Dist 2.0)))
)
(setq tempPt+ (polar tempPt cAng+ (* Dist 0.5)))
(setq tempPt- (polar tempPt cAng- (* Dist 0.5)))
(setq ntempPt+ (polar nPt cAng+ (* Dist 0.5)))
(setq ntempPt- (polar nPt cAng- (* Dist 0.5)))
(setq Pt+ (inters oPt+ nPt+ ntempPt+ tempPt+ nil))
(setq Pt- (inters oPt- nPt- ntempPt- tempPt- nil))
(if (and Pt+ Pt-)
(cond
((equal (car tempList) 5)
(redraw)
(if (= ArSty “Double”)
(DrawStartArrowHead (last PtList) (nth (- (length PtList) 2) PtList) Dist nil)
(grdraw (car StList) (cadr StList) 1)
)
(setq EndList (DrawEndArrowHead (car PtList) (polar tempPt cAng (* Dist 2.0)) Dist nil))
(setq cnt 0)
(while (< (1+ cnt) (length PtList+))
(grdraw (nth cnt PtList+) (nth (1+ cnt) PtList+) 1)
(grdraw (nth cnt PtList-) (nth (1+ cnt) PtList-) 1)
(setq cnt (1+ cnt))
)
(grvecs
(list
1 (car PtList+) Pt+
1 Pt+ tempPt+
1 tempPt- Pt-
1 Pt- (car PtList-)
)
)
)
((equal (car tempList) 3)
(setq PtList+ (cons Pt+ PtList+))
(setq PtList- (cons Pt- PtList-))
(setq PtList (cons tempPt PtList))
)
)
)
)
)
)
)
)
(if (> (length PtList) 1)
(progn
(setq EndList (DrawEndArrowHead (cadr PtList) (car PtList) Dist nil))
(setq PtList+ (cons (car EndList) PtList+))
(setq PtList- (cons (cadr EndList) PtList-))
(setq EndPtList (DrawEndArrowHead (cadr PtList) (car PtList) Dist T))
(if (= ArSty “Double”)
(progn
(setq StPtList (DrawStartArrowHead (last PtList) (nth (- (length PtList) 2) PtList) Dist T))
(setq tempPtList (append StPtList (append (reverse PtList+) (append EndPtList PtList-))))
)
(setq tempPtList (append (reverse PtList+) (append EndPtList PtList-)))
)
(foreach Pt (mapcar ‘(lambda (x) (trans x 1 0)) tempPtList)
(setq PolyPtList (cons (car Pt) PolyPtList))
(setq PolyPtList (cons (cadr Pt) PolyPtList))
)
(vla-put-Closed (vlax-invoke CurSpc ‘AddLightWeightPolyline (reverse PolyPtList)) :vlax-true)
)
)
(redraw)
(vla-EndUndoMark ActDoc)
(princ)
)