一键连接相邻线段连接成多段线，如封闭则生成封闭多段线

admin

1. (defun c:dxd( / sset i ent entpar dxf70)
3. (setq sset (ssget (list (cons 0 "*line,arc"))))
5. (vl-cmdf "undo" "be")
6. (setvar "peditaccept" 1)
8. (setq i -1)
9. (while (setq ent (ssname sset (setq i (1+ i))))
11.   (if (setq entpar (entget ent))     
12.       
13. (if (setq dxf70 (assoc 70 entpar))
15.   (if (/= 1 (cdr dxf70))  
16.    
17. (vl-cmdf "pedit" ent "j" sset "" "")
18.    )
19.   
20. (vl-cmdf "pedit" ent "j" sset "" "")
21.   ))
22. )
24. (vl-cmdf "undo" "e")
26. (princ)
28. )

复制代码

admin

2. (defun c:tt ()
3.   (if (setq ss (ssget))(command "pedit" "m" ss "" "j" "0" ""))
4.   (princ)
5. )

复制代码

admin

1. ;代码纯手打,不容易,如果你有拷贝此副本,请保留此项.
2. ;LISP 聚合程序.
3. ;BY Urings.
4. ;2016.11.22.
5. (defun |xxyyzz (un isd fuzz / an1 an2 cen crs dcr dseb ent eser esz l len n newc newo nsebs pls pt1 pt2 rad untp xx yy zz)
6.   (defun xx (sex fuzz / are areis ari arr arris ars arsis dsn len n pid pidc pide pidis pidn pidnis pxs xsex)
7.     (setq len (1- (length sex)))
8.     (or
9.       (minusp len)
10.       (setq ars (vlax-make-safearray 2 (cons 0 len))
11.             are (vlax-make-safearray 2 (cons 0 len))
12.             arr (list ars are)
13.             arsis (vlax-make-safearray 2 (cons 0 len))
14.             areis (vlax-make-safearray 2 (cons 0 len))
15.             arris (list arsis areis)
16.             ari (vlax-make-safearray 2 (cons 0 len))
17.       )
18.     )
19.     (setq pid -1)
20.     (foreach n sex
21.       (setq pid (1+ pid))
22.       (setq pxs (cons (list (car (car n)) (cadr (car n)) pid 0) pxs))
23.       (setq pxs (cons (list (car (cadr n)) (cadr (cadr n)) pid 1) pxs))
24.       (vlax-safearray-put-element ars pid -1)
25.       (vlax-safearray-put-element are pid -1)
26.       (vlax-safearray-put-element arsis pid -1)
27.       (vlax-safearray-put-element areis pid -1)
28.     )
29.     (vl-sort pxs (function (lambda (e1 e2)
30.                              (if (equal (car e1) (car e2) fuzz)
31.                                (if (equal (cadr e1) (cadr e2) fuzz)
32.                                  (progn
33.                                    (if (zerop (cadddr e1))
34.                                      (progn
35.                                        (vlax-safearray-put-element ars (caddr e1) (caddr e2))
36.                                        (vlax-safearray-put-element arsis (caddr e1) (cadddr e2))
37.                                      )
38.                                      (progn
39.                                        (vlax-safearray-put-element are (caddr e1) (caddr e2))
40.                                        (vlax-safearray-put-element areis (caddr e1) (cadddr e2))
41.                                      )
42.                                    )
43.                                    (if (zerop (cadddr e2))
44.                                      (progn
45.                                        (vlax-safearray-put-element ars (caddr e2) (caddr e1))
46.                                        (vlax-safearray-put-element arsis (caddr e2) (cadddr e1))
47.                                      )
48.                                      (progn
49.                                        (vlax-safearray-put-element are (caddr e2) (caddr e1))
50.                                        (vlax-safearray-put-element areis (caddr e2) (cadddr e1))
51.                                      )
52.                                    )
53.                                    t
54.                                  )
55.                                  (< (cadr e1) (cadr e2))
56.                                )
57.                                (< (car e1) (car e2))
58.                              )
59.                            )
60.                  )
61.     )
62.     (repeat (setq len (1+ len))
63.       (and
64.         (/= -1 (vlax-safearray-get-element ari (setq len (1- len))))
65.         (progn
66.           (setq pid len)
67.           (setq pidis 0)
68.           (setq pidc pid)
69.           (setq pide (vlax-safearray-get-element are pid))
70.           (setq dsn (list (list pid pidis)))
71.           (while (and
72.                    (/= -1 pid)
73.                    (/= -1 pidis)
74.                    (/= -1 (setq pidn (vlax-safearray-get-element (nth pidis arr) pid)))
75.                    (/= -1 (setq pidnis (vlax-safearray-get-element (nth pidis arris) pid)))
76.                    (= pid (vlax-safearray-get-element (nth pidnis arr) pidn))
77.                  )
78.             (vlax-safearray-put-element ars pid -1)
79.             (vlax-safearray-put-element are pid -1)
80.             (vlax-safearray-put-element ari pid -1)
81.             (setq pid pidn)
82.             (setq pidis (- 1 pidnis))
83.             (setq dsn (cons (list pid pidis) dsn))
84.           )
85.           (vlax-safearray-put-element ars pid -1)
86.           (vlax-safearray-put-element are pid -1)
87.           (vlax-safearray-put-element ari pid -1)
88.           (setq pid pidc)
89.           (vlax-safearray-put-element are pid pide)
90.           (setq pidis 1)
91.           (setq dsn (reverse dsn))
92.           (while (and
93.                    (/= -1 pid)
94.                    (/= -1 pidis)
95.                    (/= -1 (setq pidn (vlax-safearray-get-element (nth pidis arr) pid)))
96.                    (/= -1 (setq pidnis (vlax-safearray-get-element (nth pidis arris) pid)))
97.                    (= pid (vlax-safearray-get-element (nth pidnis arr) pidn))
98.                  )
99.             (vlax-safearray-put-element ars pid -1)
100.             (vlax-safearray-put-element are pid -1)
101.             (vlax-safearray-put-element ari pid -1)
102.             (setq dsn (cons (list pidn pidnis) dsn))
103.             (setq pid pidn)
104.             (setq pidis (- 1 pidnis))
105.           )
106.           (vlax-safearray-put-element ars pid -1)
107.           (vlax-safearray-put-element are pid -1)
108.           (vlax-safearray-put-element ari pid -1)
109.           (setq dsn (cons (list pid pidis) dsn))
110.           (setq pxs nil)
111.           (foreach n dsn
112.             (setq pxs (cons (cons (cadr n) (nth (car n) sex)) pxs))
113.           )
114.           (setq xsex (cons pxs xsex))
115.         )
116.       )
117.     )
118.     xsex
119.   )
120.   (defun yy (sex fuzz / len m n pl plbul plcs ple pler plis plos)
121.     (foreach n sex
122.       (setq pl nil)
123.       (foreach m n
124.         (setq plbul (cadddr m))
125.         (or
126.           (zerop (car m))
127.           (setq plbul (- plbul))
128.         )
129.         (setq pl (cons (cons 42 plbul) (cons (cons 10 (nth (1+ (car m)) m)) pl)))
130.       )
131.       (setq plis 0)
132.       (setq len (length n))
133.       (and
134.         (equal (cadr pl) (last pl) fuzz)
135.         (setq plis 1
136.               pl (cddr pl)
137.               len (1- len)
138.         )
139.       )
140.       (or
141.         (and
142.           (> len 1)
143.           (setq ple (entmakex (append
144.                                 (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 len)
145.                                       (cons 70 plis)
146.                                 )
147.                                 (reverse pl)
148.                                 '((210 0. 0. 1.))
149.                               )
150.                     )
151.           )
152.           (if (zerop plis)
153.             (setq plos (cons ple plos))
154.             (setq plcs (cons ple plcs))
155.           )
156.         )
157.         (setq pler (cons pl pler))
158.       )
159.     )
160.     (list plcs plos pler)
161.   )
162.   (defun zz (crx / e es eser n)
163.     (foreach n crx
164.       (or
165.         (and
166.           (setq e (entmakex (list '(0 . "CIRCLE") '(100 . "AcDbEntity") '(100 . "ACDbCircle") (cons 10 (car n))
167.                                   (cons 40 (cadr n)) '(210 0. 0. 1.)
168.                             )
169.                   )
170.           )
171.           (setq es (cons e es))
172.         )
173.         (setq eser (cons n eser))
174.       )
175.     )
176.     (list es eser)
177.   )
178.   (setq untp (type un))
179.   (cond
180.     ((= untp 'ename)
181.       (setq l (list un))
182.     )
183.     ((= untp 'list)
184.       (setq l un)
185.     )
186.     ((= untp 'pickset)
187.       (repeat (setq len (sslength un))
188.         (setq l (cons (ssname un (setq len (1- len))) l))
189.       )
190.     )
191.   )
192.   (foreach n l
193.     (setq ent (entget n))
194.     (setq untp (cdr (assoc 0 ent)))
195.     (cond
196.       ((= untp "LINE")
197.         (setq pt1 (cdr (assoc 10 ent)))
198.         (setq pt2 (cdr (assoc 11 ent)))
199.         (if (> (distance pt1 pt2) fuzz)
200.           (setq dseb (cons (list pt1 pt2 0.0) dseb))
201.           (setq esz (cons n esz))
202.         )
203.       )
204.       ((= untp "ARC")
205.         (setq cen (cdr (assoc 10 ent)))
206.         (setq rad (cdr (assoc 40 ent)))
207.         (setq an1 (cdr (assoc 50 ent)))
208.         (setq an2 (cdr (assoc 51 ent)))
209.         (setq pt1 (polar cen an1 rad))
210.         (setq pt2 (polar cen an2 rad))
211.         (setq an1 (- an2 an1))
212.         (and
213.           (minusp an1)
214.           (setq an1 (+ an1 6.283185307179586))
215.         )
216.         (if (> (distance pt1 pt2) fuzz)
217.           (if (zerop (setq an2 (cos (setq an1 (/ an1 4.0)))))
218.             (setq dseb (cons (list pt1 pt2 1.7e308) dseb))
219.             (setq dseb (cons (list pt1 pt2 (/ (sin an1) an2)) dseb))
220.           )
221.           (if (and
222.                 (> rad fuzz)
223.                 (> an1 3.141592653589793)
224.               )
225.             (setq dcr (cons (list cen rad) dcr))
226.             (setq esz (cons n esz))
227.           )
228.         )
229.       )
230.       ((= untp "CIRCLE")
231.         (setq cen (cdr (assoc 10 ent)))
232.         (setq rad (cdr (assoc 40 ent)))
233.         (if (> rad fuzz)
234.           (setq dcr (cons (list cen rad) dcr))
235.           (setq esz (cons n esz))
236.         )
237.       )
238.       (t
239.         (setq eser (cons n eser))
240.       )
241.     )
242.   )
243.   (foreach n (append eser esz)
244.     (setq l (vl-remove n l))
245.   )  
246.   ;(princ (list dseb dcr l eser esz));debug
247.   ;(list dseb dcr l eser esz);1.(起点终点凸度)2.(圆心半径)3.(在容差内的图元)4.(不在容差内的图元)5.(相对fuzz零长度图元)
248.   (setq nsebs (xx dseb fuzz))
249.   (setq pls (yy nsebs fuzz));(list plcs plos pler);1.(闭合多段线)2.(不闭合多段线)3.(不能生成的多段线数据)
250.   (setq crs (zz dcr));(list es eser);1.(圆)2.(不能生成的圆数据)
251.   (and
252.     isd
253.     (foreach n l
254.       (entdel n);删除原数据
256.     )
257.   )
258.   (foreach n esz
259.     (entdel n);删除相对零长度实体
261.   )
262.   (setq newc (append
263.                (car pls)
264.                (car crs)
265.              )
266.   )
267.   (setq newo (cadr pls))
268.   (list newc newo (caddr pls) (cadr crs)eser)
269.   ;1.(新闭合的实体)2.(未闭合的实体)3.(不能生成的多段线数据)4.(不能生成的圆数据)5.不能识别的实体
271. )
272. (vl-load-com)
274. ;聚合测试
275. (defun c:eg (/ fuzz isd n rt ss)
276.   (setq ss (ssget));只处理线段,圆弧,圆
277.   (setq isd t);是否删除原数据
278.   (setq fuzz 0.000001);相隔多远认为是相连的,曲线的长度或圆的半径小于此值将被当成0长度实体且被删除.
279.   (nortime)
280.   (setq rt (|xxyyzz ss isd fuzz))
281.   (princ "\n*****共聚合实体*****\n")
282.   (print (sslength ss))
283.   (princ "\n*****新生成的闭合实体*****\n")
284.   (print (length(car rt)))
285.   (princ "\n*****新生成的打开实体*****\n")
286.   (print (length(cadr rt)))
287. ;  (foreach n (cadr rt)
288. ;    (redraw n 3)
289. ;  )
290.   (princ "\n*****不能生成的多段线*****\n")
291.   (print (length(caddr rt)))
292.   (princ "\n*****不能生成的圆*****\n")
293.   (print (length(cadddr rt)))
294.   (princ "\n*****未处理的实体(不是线段,圆弧或圆)*****\n")
295.   (print (length(last rt)))
296.   (princ "\n**********\n")
297.   (gettime)
298.   (setq ss nil)
299.   (princ)
300. )
302. (defun nortime nil
303.   (setvar "userr1" (getvar "tdusrtimer"))
304.   (princ)
305. )
306. (defun gettime nil
307.   (princ (strcat "\n用时:" (rtos (* (- (getvar "tdusrtimer") (getvar "userr1")) 86400) 2 3)"秒.\n"))
308.   (princ)
309. )

复制代码