[求助]这是一个对齐标注的程序，请帮忙修改一下

subtlation

这是一个对齐标注的程序，在晓东CAD那儿下载的，但是对齐标注选点时没有捕捉功能，哪位高手能不能帮我改一下程序，让我选点时可以适用捕捉功能。

meflying

其余均为做任何修改。。。

2. 
   
3.                                         ;修改<35%代码,请标明aeo
   
4.                                         ;有更好的,希望贴出来大家分享
   
5. (defun c:TD (/            ang           e          en         j        len    olderr os
   
6.              pt1    pt2           pt3          pt4         ss        aeoerr trim-dim
   
7.              dxf
   
8.             )
   
9.   (defun dxf (a b) (cdr (assoc a b)))
   
10.   (defun aeoerr        (msg)
    
11.     (command "_.undo" "end" ^c)
    
12.     (setvar "osmode" os)
    
13.     (setq *error* olderr)
    
14.   )
    
15.   (defun trim-dim (pt1 pt2 ss / ent entl i np13 np14 p10 p13 p14 ptt)
    
16.                                         ; 这一; 段改自"程序（函数）库"
    
17.     (setvar "osmode" 0)
    
18.     (setq pt1 (trans pt1 1 0)
    
19.           pt2 (trans pt2 1 0)
    
20.           i   0
    
21.     )
    
22.     (repeat (sslength ss)
    
23.       (setq ent         (ssname ss i)
    
24.             entl (entget ent)
    
25.             p10         (cdr (assoc 10 entl))
    
26.             p13         (cdr (assoc 13 entl))
    
27.             p14         (cdr (assoc 14 entl))
    
28.             ptt         (cdr (assoc 11 entl))
    
29.             i         (1+ i)
    
30.             np14 (inters
    
31.                    pt1 pt2 p14 p10 nil)
    
32.       )
    
33.       (if (not (member '(100 . "AcDbRotatedDimension") entl))
    
34.         (setq np13 (polar np14 (angle p14 p13) (distance p14 p13)))
    
35.         (setq np13 (inters
    
36.                      pt1
    
37.                      pt2
    
38.                      p13
    
39.                      (polar p13 (angle p14 p10) 100)
    
40.                      nil
    
41.                    )
    
42.         )
    
43.       )
    
44.       (setq entl (subst
    
45.                    (cons 13 np13)
    
46.                    (assoc 13 entl)
    
47.                    entl
    
48.                  )
    
49.             entl (subst
    
50.                    (cons 14 np14)
    
51.                    (assoc 14 entl)
    
52.                    entl
    
53.                  )
    
54.       )
    
55.       (entmod entl)
    
56.     )
    
57.   )
    
58. ;;;;;;;
    
59.   (setq        os        (getvar "osmode")
    
60.         olderr        *error*
    
61.         *error*        aeoerr
    
62.   )
    
63.   (setvar "osmode" 0)
    
64.   (command "undo" "group")
    
65.   (prompt "\nby aeo")
    
66.   (prompt "\n不要修改的标注不要选在里面")
    
67.   (if (setq ss (ssget '((0 . "DIMENSION"))))
    
68.     (progn
    
69.       (setq en (entget (ssname ss 0)))
    
70.       (if (member '(100 . "AcDbRotatedDimension") en)
    
71.         (setq ang (dxf 50 en))
    
72.         (setq ang (angle (dxf 13 en) (dxf 14 en)))
    
73.       )
    
74.     )
    
75.   )
    
76.   (setvar "osmode" 15359)
    
77.   (if (and
    
78.         ang
    
79.         (setq pt1 (getpoint "\n标注线位置(回车不改):"))
    
80.       )
    
81.     (progn
    
82.       (setq pt2        (polar pt1 ang 1000)
    
83.             j        0
    
84.             len        (sslength ss)
    
85.       )
    
86.       (setvar "osmode" 0)
    
87.       (while (< j len)
    
88.         (setq e          (ssname ss j)
    
89.               en  (entget (ssname ss j))
    
90.               pt3 (dxf 10 en)
    
91.               pt4 (inters
    
92.                     pt1
    
93.                     pt2
    
94.                     pt3
    
95.                     (polar pt3 (+ ang (* 0.5 pi)) 100)
    
96.                     nil
    
97.                   )
    
98.               j          (1+ j)
    
99.         )       
    
100.         (command "move" e "" pt3 pt4)
     
101.       )
     
102.     )
     
103.   )
     
104.   (setvar "osmode" 15359)
     
105.   (if (and
     
106.         ang
     
107.         (setq pt1 (getpoint "\n引出线位置(回车不改):"))
     
108.       )
     
109.     (trim-dim pt1 (polar pt1 ang 100) ss)
     
110.   )
     
111.   (setvar "osmode" os)
     
112.   (setq *error* olderr)
     
113.   (command "_.undo" "end")
     
114.   (princ)
     
115. )

<br />                                         ;修改<35%代码,请标明aeo<br />                                         ;有更好的,希望贴出来大家分享<br /> (defun c:TD (/            ang           e          en         j        len    olderr os<br />              pt1    pt2           pt3          pt4         ss        aeoerr trim-dim<br />              dxf<br />             )<br />   (defun dxf (a b) (cdr (assoc a b)))<br />   (defun aeoerr        (msg)<br />     (command "_.undo" "end" ^c)<br />     (setvar "osmode" os)<br />     (setq *error* olderr)<br />   )<br />   (defun trim-dim (pt1 pt2 ss / ent entl i np13 np14 p10 p13 p14 ptt)<br />                                         ; 这一; 段改自"程序（函数）库"<br />     (setvar "osmode" 0)<br />     (setq pt1 (trans pt1 1 0)<br />           pt2 (trans pt2 1 0)<br />           i   0<br />     )<br />     (repeat (sslength ss)<br />       (setq ent         (ssname ss i)<br />             entl (entget ent)<br />             p10         (cdr (assoc 10 entl))<br />             p13         (cdr (assoc 13 entl))<br />             p14         (cdr (assoc 14 entl))<br />             ptt         (cdr (assoc 11 entl))<br />             i         (1+ i)<br />             np14 (inters<br />                    pt1 pt2 p14 p10 nil)<br />       )<br />       (if (not (member '(100 . "AcDbRotatedDimension") entl))<br />         (setq np13 (polar np14 (angle p14 p13) (distance p14 p13)))<br />         (setq np13 (inters<br />                      pt1<br />                      pt2<br />                      p13<br />                      (polar p13 (angle p14 p10) 100)<br />                      nil<br />                    )<br />         )<br />       )<br />       (setq entl (subst<br />                    (cons 13 np13)<br />                    (assoc 13 entl)<br />                    entl<br />                  )<br />             entl (subst<br />                    (cons 14 np14)<br />                    (assoc 14 entl)<br />                    entl<br />                  )<br />       )<br />       (entmod entl)<br />     )<br />   )<br /> ;;;;;;;<br />   (setq        os        (getvar "osmode")<br />         olderr        *error*<br />         *error*        aeoerr<br />   )<br />   (setvar "osmode" 0)<br />   (command "undo" "group")<br />   (prompt "\nby aeo")<br />   (prompt "\n不要修改的标注不要选在里面")<br />   (if (setq ss (ssget '((0 . "DIMENSION"))))<br />     (progn<br />       (setq en (entget (ssname ss 0)))<br />       (if (member '(100 . "AcDbRotatedDimension") en)<br />         (setq ang (dxf 50 en))<br />         (setq ang (angle (dxf 13 en) (dxf 14 en)))<br />       )<br />     )<br />   )<br />   (setvar "osmode" 15359)<br />   (if (and<br />         ang<br />         (setq pt1 (getpoint "\n标注线位置(回车不改):"))<br />       )<br />     (progn<br />       (setq pt2        (polar pt1 ang 1000)<br />             j        0<br />             len        (sslength ss)<br />       )<br />       (setvar "osmode" 0)<br />       (while (< j len)<br />         (setq e          (ssname ss j)<br />               en  (entget (ssname ss j))<br />               pt3 (dxf 10 en)<br />               pt4 (inters<br />                     pt1<br />                     pt2<br />                     pt3<br />                     (polar pt3 (+ ang (* 0.5 pi)) 100)<br />                     nil<br />                   )<br />               j          (1+ j)<br />         )        <br />         (command "move" e "" pt3 pt4)<br />       )<br />     )<br />   )<br />   (setvar "osmode" 15359)<br />   (if (and<br />         ang<br />         (setq pt1 (getpoint "\n引出线位置(回车不改):"))<br />       )<br />     (trim-dim pt1 (polar pt1 ang 100) ss)<br />   )<br />   (setvar "osmode" os)<br />   (setq *error* olderr)<br />   (command "_.undo" "end")<br />   (princ)<br /> )

subtlation

能捕捉了，谢谢meflying

artx

很好用呢，谢谢！

congcong

好像不支持坐标标注，角度标注。