[LISP程序]：类似天正增补尺寸的程序(有更新)

qiaqiadeng

本程序类似天正增补尺寸，但用的是CAD普通的尺寸标注，可以回退和往前增加尺寸，非常方便，TSSD到目前还没开发出来，没办法，只好自己操刀了。0长度尺寸的问题解决了，代码如下：
(defun dyq-add-dimension (obj           promptstr             /              xz       i        num         ps          pe           ang
                          zbpnt           key            mindist  keymin   tmpdistps                tmpdistpe          tmppnt   dist
                          dist1           dist2    objlist
                         ) ;选中与obj相连的尺寸、连续标注、往回增补尺寸
  (if (wcmatch (cdr (assoc 0 (entget obj))) "DIMENSION") ;尺寸标注则
    (progn
      (setq xz (dyq-get-connect-dimension obj)) ;获得与obj相连的标注
      (setq i 0) ;将对象亮显
      (setq num (sslength xz))
      (repeat num
        (redraw (ssname xz i) 3)
        (setq i (+ i 1))
      )

      (setq ps (cdr (assoc '14 (entget obj)))) ;拾取对象左定位点
      (setq pe (cdr (assoc '10 (entget obj)))) ;拾取对象尺寸定位点
      (setq ang (angle ps pe)) ;尺寸文字转-90度
      (while (setq zbpnt (getpoint ps promptstr))
        (setvar "OSMODE" 0)

  ;以下排除长度为0的标注
        (setq num (sslength xz)
              i          0
        )

        (setq shipinglen 1000.0)
        (repeat        num
          (redraw (ssname xz i) 3) ;将对象亮显
          (setq tmpobjlist (entget (ssname xz i))) ;尺寸的列表
          (setq tmpobjp0 (cdr (assoc '10 tmpobjlist))) ;10属性
          (setq tmpobjp3 (cdr (assoc '13 tmpobjlist))) ;13属性
          (setq tmpobjp4 (cdr (assoc '14 tmpobjlist))) ;14属性
          (setq tmpang (angle tmpobjp0 tmpobjp4))
          (setq        shipinglen (min        shipinglen
                                (dyq-distance-pt-twoPoint zbpnt tmpobjp0 tmpobjp4 nil)
                           )
          ) ;找出最小值
          (setq        shipinglen (min        shipinglen
                                (dyq-distance-pt-twoPoint zbpnt
                                                          tmpobjp3
                                                          (polar tmpobjp3 tmpang 10)
                                                          nil
                                )
                           )
          ) ;找出最小值
          (setq i (+ i 1))
        )

        (if (< shipinglen 0.000001)
          (princ "\n点太近,请继续选择。")
          (progn
            (setq key -1)
            (setq i 0) ;找到断开点所处位置
            (setq num (sslength xz))
            (repeat num
              (setq ps (cdr (assoc '13 (entget (ssname xz i))))) ;左定位点
              (setq pe (cdr (assoc '14 (entget (ssname xz i))))) ;右定位点
              (setq pe (dyq-get-per pe ps (polar ps (- ang (* 0.5 pi)) 10))) ;新右定位点
              (if (= i 0)
                (setq mindist (min (dyq-distance-pt-twoPoint
                                     zbpnt
                                     ps
                                     (polar ps ang 10)
                                     nil
                                   ) ;离zbpnt最近的左对齐点(沿ang方向)
                                   (dyq-distance-pt-twoPoint
                                     zbpnt
                                     pe
                                     (polar pe ang 10)
                                     nil
                                   )
                              ) ;离zbpnt最近的右对齐点(沿ang方向)
                      keymin  0 ;保存最近点的序号
                )
                (progn
                  (setq        tmpdistps (dyq-distance-pt-twoPoint
                                    zbpnt
                                    ps
                                    (polar ps ang 10)
                                    nil
                                  )
                        tmpdistpe (dyq-distance-pt-twoPoint
                                    zbpnt
                                    pe
                                    (polar pe ang 10)
                                    nil
                                  )
                  )
                  (if (or (< tmpdistps mindist) (< tmpdistpe mindist))
                    (setq mindist (min tmpdistps tmpdistpe)
                          keymin  i
                    )
                  )
                )
              )
              (setq tmppnt (inters ps pe zbpnt (polar zbpnt ang 10) nil))
              (setq dist (distance ps pe))
              (setq dist1 (distance ps tmppnt))
              (setq dist2 (distance pe tmppnt))
              (if (and (not (or        (< dist 1)
                                (< dist1 1)
                                (< dist2 1)
                            )
                       )
                       (< (abs (- dist dist1 dist2)) 0.000001)
                  ) ;增加点在尺寸线上产生0长度标注的情况
                (setq key i)
              )
              (setq i (+ i 1))
            )
            (if        (> key -1) ;如果点在尺寸范围内
              (progn
                (setq obj (ssname xz key))
                (setq objlist (entget obj)) ;断开点所在尺寸标注列表
                (setq ps (cdr (assoc '13 objlist))) ;左定位点
                (setq pe (cdr (assoc '14 objlist))) ;右定位点
                (setq tmppnt (dyq-get-per zbpnt ps (polar ps (- ang (* 0.5 pi)) 10))) ;zbpnt在ps沿ang-90度方向上的垂足
                (setq objlist (subst (cons 14 tmppnt) (assoc '14 objlist) objlist)) ;将tmppnt赋给key个对象的右定位点
                (entmod objlist)

                (command "copy" obj "" ps tmppnt)
                (setq obj (entlast))
                (dyq-Layer-DIM "DIM" 3)
                (setq objlist (entget obj))
                (setq ps (cdr (assoc '13 objlist))) ;左定位点
                (setq xz (ssadd obj xz))
                (setq tmppnt (dyq-get-per pe ps (polar ps (- ang (* 0.5 pi)) 10)))
                (setq objlist (subst (cons 14 tmppnt) (assoc '14 objlist) objlist))
                (entmod objlist)
              )
              (progn ;如果点在尺寸范围外
                (setq obj (ssname xz keymin))
                (command "copy" obj "" ps ps)
                (dyq-Layer-DIM "DIM" 3)
                (setq obj (entlast))
                (setq objlist (entget obj))
                (setq ps (cdr (assoc '13 objlist))) ;左定位点
                (setq pe (cdr (assoc '14 objlist))) ;右定位点
                (setq xz (ssadd obj xz))
                (if (< (dyq-distance-pt-twoPoint
                         zbpnt
                         ps
                         (polar ps ang 10)
                         nil
                       )
                       (dyq-distance-pt-twoPoint
                         zbpnt
                         pe
                         (polar pe ang 10)
                         nil
                       )
                    )
                  ()
                  (setq ps pe)
                )
                (setq tmppnt (dyq-get-per ps zbpnt (polar zbpnt ang 10)))
                (setq objlist (subst (cons 13 ps) (assoc '13 objlist) objlist))
                (entmod objlist)
                (setq objlist (subst (cons 14 tmppnt) (assoc '14 objlist) objlist))
                (entmod objlist)

              )
            )
          )
        )

        (setvar "OSMODE" 33)
      )
    )
  )
  (setq i 0) ;将对象去掉亮显
  (setq num (sslength xz))
  (repeat num
    (redraw (ssname xz i) 4)
    (setq i (+ i 1))
  )
)

lemonx

TSSD有尺寸断开，也是向前增补的
你的有何特色？下载不了

qiaqiadeng

包括断开和增补，很好用的，但有个问题就是不能点已有的尺寸的标注点，否则形成一个零长度的标注，然后再增补就出错了，还有待改进，先讲究着用吧

2. 
   
3. (defun *$dyq-error$* (msg)
   
4.   ;(command ".undo" "")
   
5.   (setq *error* &olderr&)
   
6.   ;(princ)
   
7. )
   
8. 
   
9. (defun dyq-get-per (p1 ps pe / i) ;p1在ps、pe的连线上的垂足
   
10.   (setq ang1 (angle ps pe))
    
11.   (inters ps pe p1 (polar p1 (+ ang1 (* 0.5 pi)) 100) nil)
    
12. )
    
13. 
    
14. (defun dyq-distance-pt-twoPoint        (p1 ps pe torf / p2 p3 lang)
    
15.   ;点到两点连成的直线的距离
    
16.   (setq lang (angle ps pe))
    
17.   (if (< (- lang (/ pi 2)) 0.0)
    
18.     (setq lang (+ lang (/ pi 2)))
    
19.     (setq lang (- lang (/ pi 2)))
    
20.   )
    
21.   (setq p2 (polar p1 lang 100))
    
22.   (setq p3 (inters p1 p2 ps pe torf))
    
23.   (distance p1 p3)
    
24. )
    
25. 
    
26. (defun dyq-Layer-DIM (ln lc / dimlist)
    
27.   ;将最近生成的对象设置成DIM图层 ln--图层名，lc---图层颜色
    
28.   (setq dimlist (entget (entlast)))
    
29.   (if (tblsearch "layer" ln) ;如果图层已经存在
    
30.     (progn
    
31.       (command "-layer" "c" lc ln "") ;将颜色设置成规定的颜色lc
    
32.       (setq dimlist (subst (cons '8 "DIM") (assoc '8 dimlist) dimlist))
    
33.   ;更新
    
34.     )
    
35.     (progn
    
36.       (new_layer ln lc) ;新建图层
    
37.       (setq dimlist (subst (cons '8 "DIM") (assoc '8 dimlist) dimlist))
    
38.   ;更新
    
39.     )
    
40.   )
    
41.   (entmod dimlist)
    
42. )
    
43. 
    
44. (defun dyq-add-dimension (obj           promptstr             /              xz       i        num         ps          pe           ang
    
45.                           zbpnt           key            mindist  keymin   tmpdistps                tmpdistpe          tmppnt   dist
    
46.                           dist1           dist2    objlist
    
47.                          ) ;选中与obj相连的尺寸、连续标注、往回增补尺寸
    
48.   (if (wcmatch (cdr (assoc 0 (entget obj))) "DIMENSION") ;尺寸标注则
    
49.     (progn
    
50.       (setq xz (dyq-get-connect-dimension obj)) ;获得与obj相连的标注
    
51.       (setq i 0) ;将对象亮显
    
52.       (setq num (sslength xz))
    
53.       (repeat num
    
54.         (redraw (ssname xz i) 3)
    
55.         (setq i (+ i 1))
    
56.       )
    
57. 
    
58.       (setq ps (cdr (assoc '14 (entget obj)))) ;拾取对象左定位点
    
59.       (setq pe (cdr (assoc '10 (entget obj)))) ;拾取对象尺寸定位点
    
60.       (setq ang (angle ps pe)) ;尺寸文字转-90度
    
61.       (while (setq zbpnt (getpoint ps promptstr))
    
62.         (setvar "OSMODE" 0)
    
63.         (setq i 0) ;将对象亮显
    
64.         (setq num (sslength xz))
    
65.         (repeat        num
    
66.           (redraw (ssname xz i) 3)
    
67.           (setq i (+ i 1))
    
68.         )
    
69. 
    
70.         (setq key -1)
    
71.         (setq i 0) ;找到断开点所处位置
    
72.         (setq num (sslength xz))
    
73.         (repeat        num
    
74.           (setq ps (cdr (assoc '13 (entget (ssname xz i))))) ;左定位点
    
75.           (setq pe (cdr (assoc '14 (entget (ssname xz i))))) ;右定位点
    
76.           (setq pe (dyq-get-per pe ps (polar ps (- ang (* 0.5 pi)) 10))) ;新右定位点
    
77.           (if (= i 0)
    
78.             (setq mindist (min (dyq-distance-pt-twoPoint
    
79.                                  zbpnt
    
80.                                  ps
    
81.                                  (polar ps ang 10)
    
82.                                  nil
    
83.                                ) ;离zbpnt最近的左对齐点(沿ang方向)
    
84.                                (dyq-distance-pt-twoPoint
    
85.                                  zbpnt
    
86.                                  pe
    
87.                                  (polar pe ang 10)
    
88.                                  nil
    
89.                                )
    
90.                           ) ;离zbpnt最近的右对齐点(沿ang方向)
    
91.                   keymin  0 ;保存最近点的序号
    
92.             )
    
93.             (progn
    
94.               (setq tmpdistps (dyq-distance-pt-twoPoint
    
95.                                 zbpnt
    
96.                                 ps
    
97.                                 (polar ps ang 10)
    
98.                                 nil
    
99.                               )
    
100.                     tmpdistpe (dyq-distance-pt-twoPoint
     
101.                                 zbpnt
     
102.                                 pe
     
103.                                 (polar pe ang 10)
     
104.                                 nil
     
105.                               )
     
106.               )
     
107.               (if (or (< tmpdistps mindist) (< tmpdistpe mindist))
     
108.                 (setq mindist (min tmpdistps tmpdistpe)
     
109.                       keymin  i
     
110.                 )
     
111.               )
     
112.             )
     
113.           )
     
114.           (setq tmppnt (inters ps pe zbpnt (polar zbpnt ang 10) nil))
     
115.           (setq dist (distance ps pe))
     
116.           (setq dist1 (distance ps tmppnt))
     
117.           (setq dist2 (distance pe tmppnt))
     
118.           (if (and (not        (or (< dist 1)
     
119.                             (< dist1 1)
     
120.                             (< dist2 1)
     
121.                         )
     
122.                    )
     
123.                    (< (abs (- dist dist1 dist2)) 0.000001)
     
124.               ) ;增加点在尺寸线上产生0长度标注的情况
     
125.             (setq key i)
     
126.           )
     
127.           (setq i (+ i 1))
     
128.         )
     
129.         (if (> key -1) ;如果点在尺寸范围内
     
130.           (progn
     
131.             (setq obj (ssname xz key))
     
132.             (setq objlist (entget obj)) ;断开点所在尺寸标注列表
     
133.             (setq ps (cdr (assoc '13 objlist))) ;左定位点
     
134.             (setq pe (cdr (assoc '14 objlist))) ;右定位点
     
135.             (setq tmppnt (dyq-get-per zbpnt ps (polar ps (- ang (* 0.5 pi)) 10))) ;zbpnt在ps沿ang-90度方向上的垂足
     
136.             (setq objlist (subst (cons 14 tmppnt) (assoc '14 objlist) objlist)) ;将tmppnt赋给key个对象的右定位点
     
137.             (entmod objlist)
     
138. 
     
139.             (command "copy" obj "" ps tmppnt)
     
140.             (setq obj (entlast))
     
141.             (dyq-Layer-DIM "DIM" 3)
     
142.             (setq objlist (entget obj))
     
143.             (setq ps (cdr (assoc '13 objlist))) ;左定位点
     
144.             (setq xz (ssadd obj xz))
     
145.             (setq tmppnt (dyq-get-per pe ps (polar ps (- ang (* 0.5 pi)) 10)))
     
146.             (setq objlist (subst (cons 14 tmppnt) (assoc '14 objlist) objlist))
     
147.             (entmod objlist)
     
148.           )
     
149.           (progn ;如果点在尺寸范围外
     
150.             (setq obj (ssname xz keymin))
     
151.             (command "copy" obj "" ps ps)
     
152.             (dyq-Layer-DIM "DIM" 3)
     
153.             (setq obj (entlast))
     
154.             (setq objlist (entget obj))
     
155.             (setq ps (cdr (assoc '13 objlist))) ;左定位点
     
156.             (setq pe (cdr (assoc '14 objlist))) ;右定位点
     
157.             (setq xz (ssadd obj xz))
     
158.             (if        (< (dyq-distance-pt-twoPoint
     
159.                      zbpnt
     
160.                      ps
     
161.                      (polar ps ang 10)
     
162.                      nil
     
163.                    )
     
164.                    (dyq-distance-pt-twoPoint
     
165.                      zbpnt
     
166.                      pe
     
167.                      (polar pe ang 10)
     
168.                      nil
     
169.                    )
     
170.                 )
     
171.               ()
     
172.               (setq ps pe)
     
173.             )
     
174.             (setq tmppnt (dyq-get-per ps zbpnt (polar zbpnt ang 10)))
     
175.             (setq objlist (subst (cons 13 ps) (assoc '13 objlist) objlist))
     
176.             (entmod objlist)
     
177.             (setq objlist (subst (cons 14 tmppnt) (assoc '14 objlist) objlist))
     
178.             (entmod objlist)
     
179. 
     
180.           )
     
181.         )
     
182.         (setvar "OSMODE" 33)
     
183.       )
     
184.     )
     
185.   )
     
186. )
     
187. 
     
188. (defun dyq-get-connect-dimension (obj / objlist p0 p1 p3 p4 ang alldimension num xz i ang1)
     
189.   (setq objlist (entget obj)) ;获得与所选择尺寸标注相连的所有可能标注,速度太慢，要改进
     
190.   (setq p0 (cdr (assoc 10 objlist)))
     
191.   (setq p1 (cdr (assoc 11 objlist)))
     
192.   (setq p3 (cdr (assoc 13 objlist)))
     
193.   (setq p4 (cdr (assoc 14 objlist)))
     
194.   (setq ang (+ (* 0.5 pi) (angle p4 p0))) ;标注角度
     
195.   (command "zoom" "e")
     
196.   (if
     
197.     (setq alldimension
     
198.            (ssget "c"
     
199.                   (polar p0 (+ ang (* 0.5 pi)) 10e10)
     
200.                   (polar p0 (- ang (* 0.5 pi)) 10e10)
     
201.                   '((0 . "DIMENSION"))
     
202.            )
     
203.     )
     
204.      (progn
     
205.        (setq num (sslength alldimension))
     
206.        (setq xz (ssadd))
     
207.        (setq i 0)
     
208.        (repeat num
     
209.          (setq ang1 (angle p0 (cdr (assoc 10 (entget (ssname alldimension i))))))
     
210.          (setq absang (- ang ang1))
     
211.          (if (or (= absang pi)
     
212.                  (= absang 0)
     
213.              ) ;存在风险，但不大
     
214.            (setq xz (ssadd (ssname alldimension i) xz))
     
215.          )
     
216.          (setq i (+ i 1))
     
217.        )
     
218. 
     
219.      )
     
220.   )
     
221.   (command "zoom" "p")
     
222.   (setq xz (ssadd obj xz))
     
223.   xz
     
224. )
     
225. 
     
226. 
     
227. (princ "\ndd  将对象打断于点")
     
228. (defun c:dd (/ pt1 xz obj key)
     
229.   (princ "将对象打断于点")
     
230.   (setq &olderr& *error*)
     
231.   (setq *error* *$dyq-error$*)
     
232.   (setvar "ORTHOMODE" 0)
     
233.   (if (setq obj (entsel))
     
234.     (if        (wcmatch (cdr (assoc 0 (entget (car obj))))
     
235.                  "LINE,LWPOLYLINE,ARC"
     
236.         ) ;直线、多段线、圆弧则直接打断
     
237.       (command "_Break"
     
238.                obj
     
239.                "f"
     
240.                (setq pt1 (getpoint "\n打断点:"))
     
241.                pt1
     
242.       )
     
243.       (dyq-add-dimension (car obj) "\n点取尺寸断开点:")
     
244.     )
     
245.   )
     
246. 
     
247.   (setq i 0) ;清除对象亮显
     
248.   (setq num (sslength xz))
     
249.   (repeat num
     
250.     (redraw (ssname xz i) 4)
     
251.     (setq i (+ i 1))
     
252.   )
     
253.   (setq *error* &olderr&)
     
254.   (princ)
     
255. )

<br /> (defun *$dyq-error$* (msg)<br />   ;(command ".undo" "")<br />   (setq *error* &olderr&)<br />   ;(princ)<br /> )<br /> <br /> (defun dyq-get-per (p1 ps pe / i) ;p1在ps、pe的连线上的垂足<br />   (setq ang1 (angle ps pe))<br />   (inters ps pe p1 (polar p1 (+ ang1 (* 0.5 pi)) 100) nil)<br /> )<br /> <br /> (defun dyq-distance-pt-twoPoint        (p1 ps pe torf / p2 p3 lang)<br />   ;点到两点连成的直线的距离<br />   (setq lang (angle ps pe))<br />   (if (< (- lang (/ pi 2)) 0.0)<br />     (setq lang (+ lang (/ pi 2)))<br />     (setq lang (- lang (/ pi 2)))<br />   )<br />   (setq p2 (polar p1 lang 100))<br />   (setq p3 (inters p1 p2 ps pe torf))<br />   (distance p1 p3)<br /> )<br /> <br /> (defun dyq-Layer-DIM (ln lc / dimlist)<br />   ;将最近生成的对象设置成DIM图层 ln--图层名，lc---图层颜色<br />   (setq dimlist (entget (entlast)))<br />   (if (tblsearch "layer" ln) ;如果图层已经存在<br />     (progn<br />       (command "-layer" "c" lc ln "") ;将颜色设置成规定的颜色lc<br />       (setq dimlist (subst (cons '8 "DIM") (assoc '8 dimlist) dimlist))<br />   ;更新<br />     )<br />     (progn<br />       (new_layer ln lc) ;新建图层<br />       (setq dimlist (subst (cons '8 "DIM") (assoc '8 dimlist) dimlist))<br />   ;更新<br />     )<br />   )<br />   (entmod dimlist)<br /> )<br /> <br /> (defun dyq-add-dimension (obj           promptstr             /              xz       i        num         ps          pe           ang<br />                           zbpnt           key            mindist  keymin   tmpdistps                tmpdistpe          tmppnt   dist<br />                           dist1           dist2    objlist<br />                          ) ;选中与obj相连的尺寸、连续标注、往回增补尺寸<br />   (if (wcmatch (cdr (assoc 0 (entget obj))) "DIMENSION") ;尺寸标注则<br />     (progn<br />       (setq xz (dyq-get-connect-dimension obj)) ;获得与obj相连的标注<br />       (setq i 0) ;将对象亮显<br />       (setq num (sslength xz))<br />       (repeat num<br />         (redraw (ssname xz i) 3)<br />         (setq i (+ i 1))<br />       )<br /> <br />       (setq ps (cdr (assoc '14 (entget obj)))) ;拾取对象左定位点<br />       (setq pe (cdr (assoc '10 (entget obj)))) ;拾取对象尺寸定位点<br />       (setq ang (angle ps pe)) ;尺寸文字转-90度<br />       (while (setq zbpnt (getpoint ps promptstr))<br />         (setvar "OSMODE" 0)<br />         (setq i 0) ;将对象亮显<br />         (setq num (sslength xz))<br />         (repeat        num<br />           (redraw (ssname xz i) 3)<br />           (setq i (+ i 1))<br />         )<br /> <br />         (setq key -1)<br />         (setq i 0) ;找到断开点所处位置<br />         (setq num (sslength xz))<br />         (repeat        num<br />           (setq ps (cdr (assoc '13 (entget (ssname xz i))))) ;左定位点<br />           (setq pe (cdr (assoc '14 (entget (ssname xz i))))) ;右定位点<br />           (setq pe (dyq-get-per pe ps (polar ps (- ang (* 0.5 pi)) 10))) ;新右定位点<br />           (if (= i 0)<br />             (setq mindist (min (dyq-distance-pt-twoPoint<br />                                  zbpnt<br />                                  ps<br />                                  (polar ps ang 10)<br />                                  nil<br />                                ) ;离zbpnt最近的左对齐点(沿ang方向)<br />                                (dyq-distance-pt-twoPoint<br />                                  zbpnt<br />                                  pe<br />                                  (polar pe ang 10)<br />                                  nil<br />                                )<br />                           ) ;离zbpnt最近的右对齐点(沿ang方向)<br />                   keymin  0 ;保存最近点的序号<br />             )<br />             (progn<br />               (setq tmpdistps (dyq-distance-pt-twoPoint<br />                                 zbpnt<br />                                 ps<br />                                 (polar ps ang 10)<br />                                 nil<br />                               )<br />                     tmpdistpe (dyq-distance-pt-twoPoint<br />                                 zbpnt<br />                                 pe<br />                                 (polar pe ang 10)<br />                                 nil<br />                               )<br />               )<br />               (if (or (< tmpdistps mindist) (< tmpdistpe mindist))<br />                 (setq mindist (min tmpdistps tmpdistpe)<br />                       keymin  i<br />                 )<br />               )<br />             )<br />           )<br />           (setq tmppnt (inters ps pe zbpnt (polar zbpnt ang 10) nil))<br />           (setq dist (distance ps pe))<br />           (setq dist1 (distance ps tmppnt))<br />           (setq dist2 (distance pe tmppnt))<br />           (if (and (not        (or (< dist 1)<br />                             (< dist1 1)<br />                             (< dist2 1)<br />                         )<br />                    )<br />                    (< (abs (- dist dist1 dist2)) 0.000001)<br />               ) ;增加点在尺寸线上产生0长度标注的情况<br />             (setq key i)<br />           )<br />           (setq i (+ i 1))<br />         )<br />         (if (> key -1) ;如果点在尺寸范围内<br />           (progn<br />             (setq obj (ssname xz key))<br />             (setq objlist (entget obj)) ;断开点所在尺寸标注列表<br />             (setq ps (cdr (assoc '13 objlist))) ;左定位点<br />             (setq pe (cdr (assoc '14 objlist))) ;右定位点<br />             (setq tmppnt (dyq-get-per zbpnt ps (polar ps (- ang (* 0.5 pi)) 10))) ;zbpnt在ps沿ang-90度方向上的垂足<br />             (setq objlist (subst (cons 14 tmppnt) (assoc '14 objlist) objlist)) ;将tmppnt赋给key个对象的右定位点<br />             (entmod objlist)<br /> <br />             (command "copy" obj "" ps tmppnt)<br />             (setq obj (entlast))<br />             (dyq-Layer-DIM "DIM" 3)<br />             (setq objlist (entget obj))<br />             (setq ps (cdr (assoc '13 objlist))) ;左定位点<br />             (setq xz (ssadd obj xz))<br />             (setq tmppnt (dyq-get-per pe ps (polar ps (- ang (* 0.5 pi)) 10)))<br />             (setq objlist (subst (cons 14 tmppnt) (assoc '14 objlist) objlist))<br />             (entmod objlist)<br />           )<br />           (progn ;如果点在尺寸范围外<br />             (setq obj (ssname xz keymin))<br />             (command "copy" obj "" ps ps)<br />             (dyq-Layer-DIM "DIM" 3)<br />             (setq obj (entlast))<br />             (setq objlist (entget obj))<br />             (setq ps (cdr (assoc '13 objlist))) ;左定位点<br />             (setq pe (cdr (assoc '14 objlist))) ;右定位点<br />             (setq xz (ssadd obj xz))<br />             (if        (< (dyq-distance-pt-twoPoint<br />                      zbpnt<br />                      ps<br />                      (polar ps ang 10)<br />                      nil<br />                    )<br />                    (dyq-distance-pt-twoPoint<br />                      zbpnt<br />                      pe<br />                      (polar pe ang 10)<br />                      nil<br />                    )<br />                 )<br />               ()<br />               (setq ps pe)<br />             )<br />             (setq tmppnt (dyq-get-per ps zbpnt (polar zbpnt ang 10)))<br />             (setq objlist (subst (cons 13 ps) (assoc '13 objlist) objlist))<br />             (entmod objlist)<br />             (setq objlist (subst (cons 14 tmppnt) (assoc '14 objlist) objlist))<br />             (entmod objlist)<br /> <br />           )<br />         )<br />         (setvar "OSMODE" 33)<br />       )<br />     )<br />   )<br /> )<br /> <br /> (defun dyq-get-connect-dimension (obj / objlist p0 p1 p3 p4 ang alldimension num xz i ang1)<br />   (setq objlist (entget obj)) ;获得与所选择尺寸标注相连的所有可能标注,速度太慢，要改进<br />   (setq p0 (cdr (assoc 10 objlist)))<br />   (setq p1 (cdr (assoc 11 objlist)))<br />   (setq p3 (cdr (assoc 13 objlist)))<br />   (setq p4 (cdr (assoc 14 objlist)))<br />   (setq ang (+ (* 0.5 pi) (angle p4 p0))) ;标注角度<br />   (command "zoom" "e")<br />   (if<br />     (setq alldimension<br />            (ssget "c"<br />                   (polar p0 (+ ang (* 0.5 pi)) 10e10)<br />                   (polar p0 (- ang (* 0.5 pi)) 10e10)<br />                   '((0 . "DIMENSION"))<br />            )<br />     )<br />      (progn<br />        (setq num (sslength alldimension))<br />        (setq xz (ssadd))<br />        (setq i 0)<br />        (repeat num<br />          (setq ang1 (angle p0 (cdr (assoc 10 (entget (ssname alldimension i))))))<br />          (setq absang (- ang ang1))<br />          (if (or (= absang pi)<br />                  (= absang 0)<br />              ) ;存在风险，但不大<br />            (setq xz (ssadd (ssname alldimension i) xz))<br />          )<br />          (setq i (+ i 1))<br />        )<br /> <br />      )<br />   )<br />   (command "zoom" "p")<br />   (setq xz (ssadd obj xz))<br />   xz<br /> )<br /> <br /> <br /> (princ "\ndd  将对象打断于点")<br /> (defun c:dd (/ pt1 xz obj key)<br />   (princ "将对象打断于点")<br />   (setq &olderr& *error*)<br />   (setq *error* *$dyq-error$*)<br />   (setvar "ORTHOMODE" 0)<br />   (if (setq obj (entsel))<br />     (if        (wcmatch (cdr (assoc 0 (entget (car obj))))<br />                  "LINE,LWPOLYLINE,ARC"<br />         ) ;直线、多段线、圆弧则直接打断<br />       (command "_Break"<br />                obj<br />                "f"<br />                (setq pt1 (getpoint "\n打断点:"))<br />                pt1<br />       )<br />       (dyq-add-dimension (car obj) "\n点取尺寸断开点:")<br />     )<br />   )<br /> <br />   (setq i 0) ;清除对象亮显<br />   (setq num (sslength xz))<br />   (repeat num<br />     (redraw (ssname xz i) 4)<br />     (setq i (+ i 1))<br />   )<br />   (setq *error* &olderr&)<br />   (princ)<br /> )

softbird

更新后的程序的命令是什么？看不出来。请教一下

qiaqiadeng

主程序在下面－－－－c:dd,执行dd就行了

Dallas_whu

程序有BUG，断开的尺寸总是以断点为中心，生成2个尺寸。

ljfei800501

您好楼主！

能帮忙写个天正II外包尺寸程序（每次标注尺寸时都不能把外墙250厚标注上）吗？

先谢谢了！！

qiaqiadeng

天正外包功能太强大了，我的水平不够，不好意思，无能为力了

Archs

无法下载附件！

szlmh

TSSD有尺寸断开，也是向前增补的
你的有何特色？下载不了

123456abc

我下载不了啊  哎

kkk3kkk

是否要跟天正程序用

kkk3kkk

是否要跟天正程序用

yiyu_ye

这个试试看··············