hi all
here's draw a leader , it's so simple
;;;to draw a leader and change the direction with mouse move
;;;by GSLS(SS)
(defun c:ss_JT (/ pt1 pt2 pt3 pt is_back0 is_go_on en en1)
(svos)
(setvar 'cmdecho 0)
(setvar 'PICKSTYLE 0)
(setq pt1 (getpoint))
(setq pt2 (getpoint pt1))
(entmake (list (cons 0 "LINE") (cons 10 pt1) (cons 11 pt2)))
(setq en1 (entlast))
(redraw en1 3)
(setq pt3 (getpoint pt2))
(draw-pline
(list pt1 pt2 (polar pt3 (angle pt3 pt2) 450) pt3) ;_here you can change the Neck Point Distance '450'
'((0.0 0.0) (0.0 0.0) (150.0 0.0) (0.0 0.0)); here you can change the Neck Width '150.0'
nil
nil
-1
0
)
(setq en (entlast))
(redraw en 3)
(entdel en1)
(setq pt (grread t 4 2))
(setq is_back0
(if (< (distance (cadr pt) pt3) (distance (cadr pt) pt1))
1
-1
)
is_go_on T
)
(while (and (/= 3 (car PT))
(/= 25 (car pt))
is_go_on
)
(cond
((and (= 2 (car pt)) (or (= 13 (cadr pt)) (= 32 (cadr pt)))) ;_Space or Enter
(setq is_go_on nil)
(setq is_back
(if
(< (distance (cadr pt) pt3) (distance (cadr pt) pt1))
1
-1
)
)
(if (< (* is_back0 is_back) 0)
(progn (entdel en)
(if (= is_back 1)
(draw-pline
(list pt1 pt2 (polar pt3 (angle pt3 pt2) 450) pt3)
'((0.0 0.0) (0.0 0.0) (150.0 0.0) (0.0 0.0))
nil
nil
-1
0
)
(draw-pline
(list pt1 (polar pt1 (angle pt1 pt2) 450) pt2 pt3)
'((0.0 150.0) (0.0 0.0) (0.0 0.0) (0.0 0.0))
nil
nil
-1
0
)
)
(setq en (entlast))
(redraw en 4)
)
)
)
(t
(setq is_back
(if
(< (distance (cadr pt) pt3) (distance (cadr pt) pt1))
1
-1
)
)
(if (< (* is_back0 is_back) 0)
(progn (entdel en)
(if (= is_back 1)
(draw-pline
(list pt1 pt2 (polar pt3 (angle pt3 pt2) 450) pt3)
'((0.0 0.0) (0.0 0.0) (150.0 0.0) (0.0 0.0))
nil
nil
-1
0
)
(draw-pline
(list pt1 (polar pt1 (angle pt1 pt2) 450) pt2 pt3)
'((0.0 150.0) (0.0 0.0) (0.0 0.0) (0.0 0.0))
nil
nil
-1
0
)
)
(setq en (entlast))
(redraw en 3)
)
)
(setq is_back0 is_back)
)
) ;_cond
(setq PT (grread t 4 2))
)
(redraw en 4)
(clos)
(princ)
)
;;;Error-handing
(defun ss-errexit (msg)
(command)
(command)
(if (or (= msg "Function cancelled")
(= msg "quit / exit abort")
)
(princ msg)
(princ (strcat "\n错误: " msg))
)
(clos)
)
;;;save old sysvar
(defun svos ()
(setq #system# '("OSMODE" "ORTHOMODE" "CLAYER"
"CECOLOR" "PLINEWID" "CELTYPE"
"CMDECHO" "ELEVATION" "PICKSTYLE"
)
#vlale# (mapcar 'getvar #system#)
gsls_olderr *error*
*error* ss-errexit
)
(vla-startundomark
(vla-get-activedocument (vlax-get-acad-object))
)
)
;;;---------------------------------------------------------------------;;;
;;;call old sysvar
(defun clos ()
(vla-EndUndoMark
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(MapCar 'setvar #system# #vlale#)
(setq *error* gsls_olderr)
)
;;;--------------------------------------------------------------------------------------;;;
;;;drwa-pline ;;;
;;;--------------------------------------------------------------------------------------;;;
;;;
;;;function: to make a polyline by code and return ename
;;;
;;;Variants:
;;;pl_list: the points list offered by order
;;;width : 0.0 or num, or a list like ((0.0 0.0) (0.0 20) (20 0.0)...),if nil it will getvar "plinewid" ,
;;; if it's length noteq d90 then wid41 and wid42 equal to 0.0 .
;;;d42_lst: 0.0 or num, or nil, if nil or it's length noteq d90 then d42 equal to 0.0 .
;;;
;;;lay_pl: layername, if nil it will getvar "CLAYER"
;;;
;;;color : color number, if it's -1 then getvar "COLOR" ellse set it by the given color number
;;;
;;;Prompt:
;;;If width list or d42_lst list is Exist , it's order must be same to the pl_list,
;;; otherwise it will take out a wrong polyline .
;;;
;;;Written By GSLS(SS),2010.06.30
;;;
(defun draw-pline
(pl_list width d42_lst lay_pl color d70
/ d90 i wid d42 wid40
wid41 en000 pb
)
(setq d90 (length pl_list)
pb '()
i 0
)
(cond ((and (listp width)
(listp d42_lst)
(= (length width) (length d42_lst) d90)
)
(foreach pt pl_list
(setq wid (nth i width)
d42 (nth i d42_lst)
wid40 (car wid)
wid41 (cadr wid)
pb (append pb
(list (cons 10 pt)
(cons 40 wid40)
(cons 41 wid41)
(cons 42 d42)
)
)
i (1+ i)
)
)
)
((and (or (numberp width) (null width))
(listp d42_lst)
(= (length d42_lst) d90)
)
(if (null width)
(setq wid40 (getvar "plinewid")
wid41 (getvar "plinewid")
)
(setq wid40 width
wid41 width
)
)
(foreach pt pl_list
(setq d42 (nth i d42_lst)
pb (append pb
(list (cons 10 pt)
(cons 40 wid40)
(cons 41 wid41)
(cons 42 d42)
)
)
i (1+ i)
)
)
)
((and (listp width)
(= (length width) d90)
(or (null d42_lst) (numberp d42_lst))
)
(if (null d42_lst)
(setq d42 0.0)
(setq d42 d42_lst)
)
(foreach pt pl_list
(setq wid (nth i width)
wid40 (car wid)
wid41 (cadr wid)
pb (append pb
(list (cons 10 pt)
(cons 40 wid40)
(cons 41 wid41)
(cons 42 d42)
)
)
i (1+ i)
)
)
)
(t
(if (numberp width)
(setq wid40 width
wid41 width
)
(setq wid40 0.0
wid41 0.0
)
)
(foreach pt pl_list
(setq pb (append pb
(list (cons 10 pt)
(cons 40 wid40)
(cons 41 wid41)
(cons 42 0.0)
)
)
)
)
)
)
(setq en000 (append (list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 8
(if (and lay_pl (/= lay_pl ""))
lay_pl
(getvar "CLAYER")
)
)
(cons 100 "AcDbPolyline")
(cons 90 d90)
(cons 70 d70)
)
pb
)
)
(if (and color (/= -1 color))
(setq en000 (append en000 (list (cons 62 color))))
)
(if (= nil (entmake en000))
(princ "\nerror:entity-list error.")
)
(entlast)
)