增强ACAD的JOIN命令（支持容差、让低版本CAD支持连接SPLINE）

pengfei2010

看看 神马好东西

9635luyu

这个要看到

sunyukun

不错的插件，也想看看

hooboxu

强大,比默认的多了很多

XU838934774

11111111111111111111111111333333333333

012006024431

看看】·······

brainstorm

各种版本曲线连接 学习一下

brainstorm

增加了Grid格式的对话框
可同时设置线宽
双击容差单元格可量取设置容差值

1. (defun c:XDTB_Join (/                          #join
   
2.                     tol                          ents
   
3.                     ents1                  ss
   
4.                     ss-line                  ss-arc
   
5.                     n                          precision
   
6.                     c:XDTB_Join/Form1/Grid1#OnDblClicked
   
7.                     c:XDTB_Join/Form1#OnCancelClose
   
8.                     *error*
   
9.                    )
   
10. 
    
11.   (defun #join (n / x y)
    
12.     (foreach x n
    
13.       (foreach y n
    
14.         (if (and (not (equal x y)) (entget x) (entget y))
    
15.           (xdrx_curve_join x y)
    
16.         )
    
17.       )
    
18.     )
    
19.   )
    
20.   (defun *error* (msg)
    
21.     (if        (dcl-form-isactive XDTB_Join/Form1)
    
22.       (dcl-form-close XDTB_Join/Form1)
    
23.     )
    
24.     (apply 'xdrx_document_setprec precision)
    
25.   )
    
26.   (defun c:XDTB_Join/Form1/Grid1#OnDblClicked (Row Column /)
    
27.     (if        (eq row 0)
    
28.       (progn (if (not (setq tol
    
29.                              (getdist (strcat "\n容差<"
    
30.                                               (VL-PRINC-TO-STRING $xdtb_global_var_tol)
    
31.                                               ">:"
    
32.                                       )
    
33.                              )
    
34.                       )
    
35.                  )
    
36.                (setq tol $xdtb_global_var_tol)
    
37.                (setq $xdtb_global_var_tol tol)
    
38.              )
    
39.              (dcl-grid-setcelltext
    
40.                XDTB_Join/Form1/Grid1
    
41.                0
    
42.                1
    
43.                (VL-PRINC-TO-STRING (fix tol))
    
44.              )
    
45.       )
    
46.     )
    
47.   )
    
48.   (defun c:XDTB_Join/Form1#OnCancelClose (Reason /)
    
49.     t
    
50.   )
    
51. 
    
52. 
    
53. 
    
54.   (if (not $xdtb_global_var_tol)
    
55.     (setq $xdtb_global_var_tol 0)
    
56.   )
    
57.   (if (not $xdtb_global_var_constantwidth)
    
58.     (setq $xdtb_global_var_constantwidth 0)
    
59.   )
    
60.   (setq precision (xdrx_document_getprec))
    
61.   (setq box(last(xdrx_document_pixelbox)))
    
62. 
    
63.   (command "_opendcl")
    
64.   (dcl-project-import
    
65.     '("YWt6A9wHAAA9ScpcBuL76rUxbS9quMEc/3Wq+v6QMqou3eV4FFUqnXRlMy7a9PdQSnoWrzRXOPNk"
    
66.       "SRID0wudtPsQ84/LGB8KmWEenCWPww2f3Z0JUa1nmN26RefnjUWZok2ZoA2YCARLcYCjCHoHYrxe"
    
67.       "uE76J+ovO3K+jSjeo3QKN4gfdO2Wneu4Rsw27w2muFU7lFknV5lCNOqsqjIvQTejKBqW7QhEiTex"
    
68.       "OLLcNjV3fcKElxtd6OLJ8+a/CJQtgijwDPisfssD2lIRRV09JeSq+vozzH0I0v33L51xANgHSSkK"
    
69.       "ZE0KSzGvK8mGUJhenAvrcxyYorXze9gXmK/yW70K+4j8myvPBrqAVspFAF6CLobAjmG32VnMZmjU"
    
70.       "9s3mJixWjVKcf81b8gapOIb16AQ+GcFnn4vtpv+bm5E7xhNDZt8YaQnFtBToLt8i34tyGw0w3CFq"
    
71.       "iPohduFpwF8CM8ZbaJuhHMFeEtyA9/PqbPB56Qu0YFDGsnMQolczTj/rQDUpAnSJgumT5EefBpaR"
    
72.       "1ERcK8FTKxFpqFDSOGwxch1qZQbhDqvXLrCNB2KY4LqvkJM4JW65Tam7hfCOJLfEXuMIPpJRG4Bt"
    
73.       "z6HsKwPvMKBagIVbhcMcoVlCUkJa0gGwGLcpgdodrCVjvNGDsFx5/5PCcS/DmXGNtEHNlITkqUpB"
    
74.       "BNS6CRIZv0LolpEp9owYe4N8qEqymF3EZZSh0+6DpdZAscUWi9Vdh1uBAfCKXIK/aLHqQjHMu63a"
    
75.       "su0b5KMl+mftCyn81MYU5hef5940z+EIo80cQVdCX49Rd2FowFICK4b0DtmOL58RP6lTDFOysQuj"
    
76.       "CbeJVSRd4uqHQbyLhRGCfcdhXqk="
    
77.      )
    
78.   )
    
79.   (dcl-form-show XDTB_Join/form1)
    
80.   (dcl-form-setpos XDTB_Join/form1 (car box)(cadr box))
    
81.   (dcl-grid-filllist
    
82.     XDTB_Join/form1/grid1
    
83.     (list (list "容差" (VL-PRINC-TO-STRING $xdtb_global_var_tol))
    
84.           (list        "线宽"
    
85.                 (VL-PRINC-TO-STRING $xdtb_global_var_constantwidth)
    
86.           )
    
87.     )
    
88.   )
    
89.   (dcl-Grid-SetCellStyle XDTB_Join/Form1/Grid1 1 1 6)
    
90.   (dcl-Grid-SetCellStyle XDTB_Join/Form1/Grid1 0 1 6)
    
91. 
    
92. 
    
93.   (xdrx_begin)
    
94.   (prompt
    
95.     "\n选取要JOIN的曲线（LINE,POLYLINE,ARC,SPLINE,ELLIPSE):"
    
96.   )
    
97.   (while (setq ss (ssget '((0 . "*LINE,ARC,ELLIPSE,SPLINE"))))
    
98.     (progn
    
99.       (setq tol        (atof (dcl-grid-getcelltext
    
100.                         XDTB_Join/Form1/Grid1
     
101.                         0
     
102.                         1
     
103. 
     
104.                       )
     
105.                 )
     
106.             $xdtb_global_var_tol
     
107.              tol
     
108.             $xdtb_global_var_constantwidth
     
109.              (atof (dcl-grid-getcelltext
     
110.                      XDTB_Join/Form1/Grid1
     
111.                      1
     
112.                      1
     
113. 
     
114.                    )
     
115.              )
     
116.       )
     
117.       (xdrx_document_setprec
     
118.         tol
     
119.       )
     
120.       (setq ss-line (ssadd)
     
121.             ss-arc  (ssadd)
     
122.       )
     
123.       (xdrx_setsstodb ss 0)
     
124.       (while (setq e (xdrx_getentdata 0))
     
125.         (setq tf (car (xdrx_getpropertyvalue e "classname")))
     
126.         (cond ((= tf "LINE") (ssadd e ss-line))
     
127.               ((= tf "ARC") (ssadd e ss-arc))
     
128.         )
     
129.       )
     
130.       (setq ents (xdrx_pickset->ents ss-line))
     
131.       (setq ents1 (mapcar
     
132.                     '(lambda (x) (list (xdrx_getpropertyvalue x "angle") x))
     
133.                     ents
     
134.                   )
     
135.             ents1 (XD::assocList:MergeByNumKey ents1 0.01)
     
136.             ents1 (mapcar 'cdr ents1)
     
137.       )
     
138.       (foreach n ents1 (#join n))
     
139.       (setq ents (xdrx_pickset->ents ss-arc))
     
140.       (setq ents1 (mapcar
     
141.                     '(lambda (x)
     
142.                        (list (xdrx_getpropertyvalue x "center")
     
143.                              (list (xdrx_getpropertyvalue x "radius") x)
     
144.                        )
     
145.                      )
     
146.                     ents
     
147.                   )
     
148.             ents1 (XD::assocList:MergeByNumKey ents1 0.01)
     
149.             ents1 (mapcar 'cdr ents1)
     
150.             ents1 (mapcar '(lambda (x) (XD::assocList:MergeByNumKey x 0.01))
     
151.                           ents1
     
152.                   )
     
153.             ents1 (mapcar 'cdar ents1)
     
154.       )
     
155.       (mapcar '(lambda (x) (#join x)) ents1)
     
156.       (#join (xdrx_pickset->ents ss))
     
157.       (xdrx_setsstodb ss 0)
     
158.       (while (setq e (xdrx_getentdata 0))
     
159.         (xdrx_setpropertyvalue
     
160.           e
     
161.           "constantwidth"
     
162.           $xdtb_global_var_constantwidth
     
163.         )
     
164.       )
     
165.     )
     
166.     (prompt
     
167.       "\n选取要JOIN的曲线（LINE,POLYLINE,ARC,SPLINE,ELLIPSE):"
     
168.     )
     
169.   )
     
170.   (xdrx_end)
     
171.   (*error*)
     
172.   (princ)
     
173. )
     

(defun c:XDTB_Join (/                          #join<br />                     tol                          ents<br />                     ents1                  ss<br />                     ss-line                  ss-arc<br />                     n                          precision<br />                     c:XDTB_Join/Form1/Grid1#OnDblClicked<br />                     c:XDTB_Join/Form1#OnCancelClose<br />                     *error*<br />                    )<br /> <br />   (defun #join (n / x y)<br />     (foreach x n<br />       (foreach y n<br />         (if (and (not (equal x y)) (entget x) (entget y))<br />           (xdrx_curve_join x y)<br />         )<br />       )<br />     )<br />   )<br />   (defun *error* (msg)<br />     (if        (dcl-form-isactive XDTB_Join/Form1)<br />       (dcl-form-close XDTB_Join/Form1)<br />     )<br />     (apply 'xdrx_document_setprec precision)<br />   )<br />   (defun c:XDTB_Join/Form1/Grid1#OnDblClicked (Row Column /)<br />     (if        (eq row 0)<br />       (progn (if (not (setq tol<br />                              (getdist (strcat "\n容差<"<br />                                               (VL-PRINC-TO-STRING $xdtb_global_var_tol)<br />                                               ">:"<br />                                       )<br />                              )<br />                       )<br />                  )<br />                (setq tol $xdtb_global_var_tol)<br />                (setq $xdtb_global_var_tol tol)<br />              )<br />              (dcl-grid-setcelltext<br />                XDTB_Join/Form1/Grid1<br />                0<br />                1<br />                (VL-PRINC-TO-STRING (fix tol))<br />              )<br />       )<br />     )<br />   )<br />   (defun c:XDTB_Join/Form1#OnCancelClose (Reason /)<br />     t<br />   )<br /> <br /> <br /> <br />   (if (not $xdtb_global_var_tol)<br />     (setq $xdtb_global_var_tol 0)<br />   )<br />   (if (not $xdtb_global_var_constantwidth)<br />     (setq $xdtb_global_var_constantwidth 0)<br />   )<br />   (setq precision (xdrx_document_getprec))<br />   (setq box(last(xdrx_document_pixelbox)))<br /> <br />   (command "_opendcl")<br />   (dcl-project-import<br />     '("YWt6A9wHAAA9ScpcBuL76rUxbS9quMEc/3Wq+v6QMqou3eV4FFUqnXRlMy7a9PdQSnoWrzRXOPNk"<br />       "SRID0wudtPsQ84/LGB8KmWEenCWPww2f3Z0JUa1nmN26RefnjUWZok2ZoA2YCARLcYCjCHoHYrxe"<br />       "uE76J+ovO3K+jSjeo3QKN4gfdO2Wneu4Rsw27w2muFU7lFknV5lCNOqsqjIvQTejKBqW7QhEiTex"<br />       "OLLcNjV3fcKElxtd6OLJ8+a/CJQtgijwDPisfssD2lIRRV09JeSq+vozzH0I0v33L51xANgHSSkK"<br />       "ZE0KSzGvK8mGUJhenAvrcxyYorXze9gXmK/yW70K+4j8myvPBrqAVspFAF6CLobAjmG32VnMZmjU"<br />       "9s3mJixWjVKcf81b8gapOIb16AQ+GcFnn4vtpv+bm5E7xhNDZt8YaQnFtBToLt8i34tyGw0w3CFq"<br />       "iPohduFpwF8CM8ZbaJuhHMFeEtyA9/PqbPB56Qu0YFDGsnMQolczTj/rQDUpAnSJgumT5EefBpaR"<br />       "1ERcK8FTKxFpqFDSOGwxch1qZQbhDqvXLrCNB2KY4LqvkJM4JW65Tam7hfCOJLfEXuMIPpJRG4Bt"<br />       "z6HsKwPvMKBagIVbhcMcoVlCUkJa0gGwGLcpgdodrCVjvNGDsFx5/5PCcS/DmXGNtEHNlITkqUpB"<br />       "BNS6CRIZv0LolpEp9owYe4N8qEqymF3EZZSh0+6DpdZAscUWi9Vdh1uBAfCKXIK/aLHqQjHMu63a"<br />       "su0b5KMl+mftCyn81MYU5hef5940z+EIo80cQVdCX49Rd2FowFICK4b0DtmOL58RP6lTDFOysQuj"<br />       "CbeJVSRd4uqHQbyLhRGCfcdhXqk="<br />      )<br />   )<br />   (dcl-form-show XDTB_Join/form1)<br />   (dcl-form-setpos XDTB_Join/form1 (car box)(cadr box))<br />   (dcl-grid-filllist<br />     XDTB_Join/form1/grid1<br />     (list (list "容差" (VL-PRINC-TO-STRING $xdtb_global_var_tol))<br />           (list        "线宽"<br />                 (VL-PRINC-TO-STRING $xdtb_global_var_constantwidth)<br />           )<br />     )<br />   )<br />   (dcl-Grid-SetCellStyle XDTB_Join/Form1/Grid1 1 1 6)<br />   (dcl-Grid-SetCellStyle XDTB_Join/Form1/Grid1 0 1 6)<br /> <br /> <br />   (xdrx_begin)<br />   (prompt<br />     "\n选取要JOIN的曲线（LINE,POLYLINE,ARC,SPLINE,ELLIPSE):"<br />   )<br />   (while (setq ss (ssget '((0 . "*LINE,ARC,ELLIPSE,SPLINE"))))<br />     (progn<br />       (setq tol        (atof (dcl-grid-getcelltext<br />                         XDTB_Join/Form1/Grid1<br />                         0<br />                         1<br /> <br />                       )<br />                 )<br />             $xdtb_global_var_tol<br />              tol<br />             $xdtb_global_var_constantwidth<br />              (atof (dcl-grid-getcelltext<br />                      XDTB_Join/Form1/Grid1<br />                      1<br />                      1<br /> <br />                    )<br />              )<br />       )<br />       (xdrx_document_setprec<br />         tol<br />       )<br />       (setq ss-line (ssadd)<br />             ss-arc  (ssadd)<br />       )<br />       (xdrx_setsstodb ss 0)<br />       (while (setq e (xdrx_getentdata 0))<br />         (setq tf (car (xdrx_getpropertyvalue e "classname")))<br />         (cond ((= tf "LINE") (ssadd e ss-line))<br />               ((= tf "ARC") (ssadd e ss-arc))<br />         )<br />       )<br />       (setq ents (xdrx_pickset->ents ss-line))<br />       (setq ents1 (mapcar<br />                     '(lambda (x) (list (xdrx_getpropertyvalue x "angle") x))<br />                     ents<br />                   )<br />             ents1 (XD::assocList:MergeByNumKey ents1 0.01)<br />             ents1 (mapcar 'cdr ents1)<br />       )<br />       (foreach n ents1 (#join n))<br />       (setq ents (xdrx_pickset->ents ss-arc))<br />       (setq ents1 (mapcar<br />                     '(lambda (x)<br />                        (list (xdrx_getpropertyvalue x "center")<br />                              (list (xdrx_getpropertyvalue x "radius") x)<br />                        )<br />                      )<br />                     ents<br />                   )<br />             ents1 (XD::assocList:MergeByNumKey ents1 0.01)<br />             ents1 (mapcar 'cdr ents1)<br />             ents1 (mapcar '(lambda (x) (XD::assocList:MergeByNumKey x 0.01))<br />                           ents1<br />                   )<br />             ents1 (mapcar 'cdar ents1)<br />       )<br />       (mapcar '(lambda (x) (#join x)) ents1)<br />       (#join (xdrx_pickset->ents ss))<br />       (xdrx_setsstodb ss 0)<br />       (while (setq e (xdrx_getentdata 0))<br />         (xdrx_setpropertyvalue<br />           e<br />           "constantwidth"<br />           $xdtb_global_var_constantwidth<br />         )<br />       )<br />     )<br />     (prompt<br />       "\n选取要JOIN的曲线（LINE,POLYLINE,ARC,SPLINE,ELLIPSE):"<br />     )<br />   )<br />   (xdrx_end)<br />   (*error*)<br />   (princ)<br /> )<br />

libiao0902

看看那。。。。。。。。。

liulisheng

lzy1979

很不错的歇息额

liutong1997

非常不错，谢谢谢谢

PO0O0

不要太麻烦，找到怕

PO0O0

原因：no function definition: XD::ASSOCLIST:MERGEBYNUMKEY 位置-> 行:54 列:20


怕了

lzy1979

好东西饿想诶自我