请教关于动态引线代码
本帖最后由 uditx 于 2011-7-25 20:29 编辑各位大侠以下是我写的两段关于动态引线和直线的代码，就是引线或直线可以随光标移动 的那种，不成功，请教高手原因！
我用同样的代码结构可以作成动态字母和和圆，请指教！不胜感激！
(defun c:test ()
(while (setq p0 (getpoint "\n请输入点:"))
(command "leader" (polar p0 (\ pi 4) 0.1) p0"" "asdfasdf" "n")
(setq ceo (entget (entlast)))
(setq k 1)
(while (/= k 3)
(setq p (grread T))
(setq k (car p) p (cadr p))
(setq ceo (subst (cons 10 p) (assoc 10 ceo) ceo))
(entmod ceo)
)
(setq sn (1+ sn))
)
(princ)
)
(defun c:test ()
(while (setq p0 (getpoint "\n请输入点:"))
(command "line" p0 (polar p0 0 50) "" "asdfasdf" "n")
(setq ceo (entget (entlast)))
(setq k 1)
(while (/= k 3)
(setq p (grread T))
(setq k (car p) p (cadr p))
(setq ceo (subst (cons 10 p) (assoc 10 ceo) ceo))
(entmod ceo)
)
(setq sn (1+ sn))
)
(princ)
)
本帖最后由 ljpnb 于 2011-7-26 05:33 编辑
(defun c:test ()
(setq en0 (entlast))
(if (setq p0 (getpoint "\n请输入点:"))
(progn
(command "leader"
p0
(polar p0 (/ pi 4) 0.1)
""
"asdfasdf"
""
)
(setq en2 (entlast))
(if en0
(setq en1 (entnext en0))
(progn
(setq ss (ssget "x"))
(setq ss (ssdel en2 ss))
(setq en1 (ssname ss 0))
)
)
(setq ent1 (entget en1)
ent2 (entget en2)
)
(setq lst (vl-remove-if '(lambda (x) (/= 10 (car x))) ent1))
(setq p1 (cdr (nth 1 lst))
p2 (cdr (nth 2 lst))
)
(setq cen (cdr (assoc 10 ent2)))
(setq ang(angle p1 cen)
dis1 (distance p1 p2)
dis2 (distance p1 cen)
)
(setq k 1)
(while (/= k 3)
(setq p (grread T))
(setq k (car p)
p11 (cadr p)
)
(setq p22(polar p11 0 dis1)
cen1 (polar p11 ang dis2)
)
(setq ent1 (subst (cons 10 p22) (nth 20 ent1) ent1))
(entmod ent1)
(setq ent2 (subst (cons 10 cen1) (assoc 10 ent2) ent2))
(entmod ent2)
)
)
)
(princ)
)
谢谢，我回去试一下呀 这个正是我想找的谢谢 ljpnb 发表于 2011-7-25 23:17 static/image/common/back.gif
能不能修改在左边也能标注 ljpnb 发表于 2011-7-25 23:17 static/image/common/back.gif
一年多后才看到这个，很好用哇，要是标出的连续标出的引线可以对齐就更好啦 需要glvector这样的函数来做相应的动画效果才行。 谢谢楼主分享
页:
[1]