请教关于动态引线代码

uditx

各位大侠以下是我写的两段关于动态引线和直线的代码，就是引线或直线可以随光标移动 的那种，不成功，请教高手原因！
我用同样的代码结构可以作成动态字母和和圆，请指教！不胜感激！
(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

2. 
   
3. (defun c:test ()
   
4.   (setq en0 (entlast))
   
5.   (if (setq p0 (getpoint "\n请输入点:"))
   
6.     (progn
   
7.       (command "leader"
   
8.         p0
   
9.         (polar p0 (/ pi 4) 0.1)
   
10.         ""
    
11.         "asdfasdf"
    
12.         ""
    
13.       )
    
14.       (setq en2 (entlast))
    
15.       (if en0
    
16. (setq en1 (entnext en0))
    
17. (progn
    
18.    (setq ss (ssget "x"))
    
19.    (setq ss (ssdel en2 ss))
    
20.    (setq en1 (ssname ss 0))
    
21. )
    
22.       )
    
23.       (setq ent1 (entget en1)
    
24.      ent2 (entget en2)
    
25.       )
    
26.       (setq lst (vl-remove-if '(lambda (x) (/= 10 (car x))) ent1))
    
27.       (setq p1 (cdr (nth 1 lst))
    
28.      p2 (cdr (nth 2 lst))
    
29.       )
    
30.       (setq cen (cdr (assoc 10 ent2)))
    
31.       (setq ang  (angle p1 cen)
    
32.      dis1 (distance p1 p2)
    
33.      dis2 (distance p1 cen)
    
34.       )
    
35.       (setq k 1)
    
36.       (while (/= k 3)
    
37. (setq p (grread T))
    
38. (setq k   (car p)
    
39.        p11 (cadr p)
    
40. )
    
41. (setq p22  (polar p11 0 dis1)
    
42.        cen1 (polar p11 ang dis2)
    
43. )
    
44. (setq ent1 (subst (cons 10 p22) (nth 20 ent1) ent1))
    
45. (entmod ent1)
    
46. (setq ent2 (subst (cons 10 cen1) (assoc 10 ent2) ent2))
    
47. (entmod ent2)
    
48.       )
    
49.     )
    
50.   )
    
51.   (princ)
    
52. )
    

<br /> (defun c:test ()<br />   (setq en0 (entlast))<br />   (if (setq p0 (getpoint "\n请输入点:"))<br />     (progn<br />       (command "leader"<br />         p0<br />         (polar p0 (/ pi 4) 0.1)<br />         ""<br />         "asdfasdf"<br />         ""<br />       )<br />       (setq en2 (entlast))<br />       (if en0<br /> (setq en1 (entnext en0))<br /> (progn<br />    (setq ss (ssget "x"))<br />    (setq ss (ssdel en2 ss))<br />    (setq en1 (ssname ss 0))<br /> )<br />       )<br />       (setq ent1 (entget en1)<br />      ent2 (entget en2)<br />       )<br />       (setq lst (vl-remove-if '(lambda (x) (/= 10 (car x))) ent1))<br />       (setq p1 (cdr (nth 1 lst))<br />      p2 (cdr (nth 2 lst))<br />       )<br />       (setq cen (cdr (assoc 10 ent2)))<br />       (setq ang  (angle p1 cen)<br />      dis1 (distance p1 p2)<br />      dis2 (distance p1 cen)<br />       )<br />       (setq k 1)<br />       (while (/= k 3)<br /> (setq p (grread T))<br /> (setq k   (car p)<br />        p11 (cadr p)<br /> )<br /> (setq p22  (polar p11 0 dis1)<br />        cen1 (polar p11 ang dis2)<br /> )<br /> (setq ent1 (subst (cons 10 p22) (nth 20 ent1) ent1))<br /> (entmod ent1)<br /> (setq ent2 (subst (cons 10 cen1) (assoc 10 ent2) ent2))<br /> (entmod ent2)<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br />

uditx

谢谢，我回去试一下呀

bikeboy

这个正是我想找的  谢谢

tanle2020

ljpnb 发表于 2011-7-25 23:17

能不能修改在左边也能标注

梦里水香

ljpnb 发表于 2011-7-25 23:17

一年多后才看到这个，很好用哇，要是标出的连续标出的引线可以对齐就更好啦

yarp

需要glvector这样的函数来做相应的动画效果才行。

墨者

谢谢楼主分享