第一次发帖，求助万能的晓东家园

chenjian2159

我是做规划的小罗罗，工作中有个很重要的步骤是描图，主要是描一些建筑轮廓，平时基本上是用BO这个命令来完成，但有些地形图上面的建筑轮廓线经常有缝，没闭合，所以BO就完成不了，只能手工描，偶尔有一次看到一张图片，有缝的都能BO起来，但找不到原作者，不知道怎么实现，求万能的晓东CAD家园帮忙，希望能实现，要是可以用LISP实现，那就更好了，在此谢过！

听说过“最大内切圆”，有没有“最大内切多边形”的说法？

laibinwu

收藏的一个连接线段的程序，把模糊距离设置大一点就能实现了

1. (defun c:ljx (/ peditaccept ss mm)
   
2.   (if (= (setq mm (getreal "\n输入模糊距离<1.0>:")) nil)
   
3.     (setq mm 1.0)
   
4.   )
   
5.   (if (setq ss (ssget "_:L" '((0 . "ARC,LINE,LWPOLYLINE"))))
   
6.     (progn
   
7.       (setq peditaccept (getvar 'peditaccept))
   
8.       (setvar 'peditaccept 1)
   
9.       (command "_.pedit" "_M" ss "" "_J" mm "")
   
10.       (setvar 'peditaccept peditaccept)
    
11.     )
    
12.   )
    
13.   (princ)
    
14. )

(defun c:ljx (/ peditaccept ss mm)<br />   (if (= (setq mm (getreal "\n输入模糊距离<1.0>:")) nil)<br />     (setq mm 1.0)<br />   )<br />   (if (setq ss (ssget "_:L" '((0 . "ARC,LINE,LWPOLYLINE"))))<br />     (progn<br />       (setq peditaccept (getvar 'peditaccept))<br />       (setvar 'peditaccept 1)<br />       (command "_.pedit" "_M" ss "" "_J" mm "")<br />       (setvar 'peditaccept peditaccept)<br />     )<br />   )<br />   (princ)<br /> )

newer

楼主，这样处理行不，红色的是原来的，用白色的连上。

chenjian2159

laibinwu 发表于 2013-8-15 14:52
收藏的一个连接线段的程序，把模糊距离设置大一点就能实现了

谢谢回复，但跟所想的不一样，你这个就是PE吧{:soso_e183:}

chenjian2159

newer 发表于 2013-8-15 15:00
楼主，这样处理行不，红色的是原来的，用白色的连上。

谢谢版主大人，这样就是跟原来的线有点误差哦，假如原来的红线缺口较大，那误差不是更大了吗？基本上吻合能做到吗？跟BO那样

newer

chenjian2159 发表于 2013-8-15 15:04
谢谢回复，但跟所想的不一样，你这个就是PE吧

是啊，AUTOCAD都认为应该这样的。建筑本来应该是直线的，你的图那样的反而不是实际的，是策绘的不准吧。

chenjian2159

newer 发表于 2013-8-15 15:10
是啊，AUTOCAD都认为应该这样的。建筑本来应该是直线的，你的图那样的反而不是实际的，是策绘的不准吧。
...

测绘搞地形的有时候估计是不小心吧，导致了地形图里的好多建筑都是没有闭合，所以想看看万能的晓东里能否帮我解决下，万分感激！！！建筑有时候也不一定是直线啊，有些老房子，拐来拐去的

newer

chenjian2159 发表于 2013-8-15 15:14
测绘搞地形的有时候估计是不小心吧，导致了地形图里的好多建筑都是没有闭合，所以想看看万能的晓东里能 ...

帮你试试吧，你的线只是 LINE 和POLYLINE吧？

q3_2006

他要的是这样！

chenjian2159

q3_2006 发表于 2013-8-15 15:19
他要的是这样！

是的，不知道能否实现？

newer

q3_2006 发表于 2013-8-15 15:19
他要的是这样！

你有现成的工具？ 那帮贴上来吧。

q3_2006

就是他贴的图呀！

chenjian2159

newer 发表于 2013-8-15 15:26
你有现成的工具？ 那帮贴上来吧。

有现成的工具就不用求助了啊{:soso_e121:}

chenjian2159

newer 发表于 2013-8-15 15:18
帮你试试吧，你的线只是 LINE 和POLYLINE吧？

谢谢版主！圆弧可能也有吧，不过可能考虑进去的话，程序是不是就变复杂了？

牢固

1. ;;串接封闭线,By Gu_xl 2013.08.15
   
2. ;;一次选择一组要连线的实体
   
3. (defun c:MyJoin (/ *error* CMDECHO PEDITACCEPT SS SSL PL LST LL UR CIR CP PTS1 PTS2)
   
4.   (defun *error* (s)
   
5.     (setvar 'peditaccept peditaccept)
   
6.       (setvar 'cmdecho cmdecho)
   
7.     (princ s)
   
8.     )
   
9.   (setq cmdecho (getvar 'cmdecho))
   
10.   (setvar 'cmdecho 0)
    
11.   (setq peditaccept (getvar 'peditaccept))
    
12.   (setvar 'peditaccept 1)
    
13.   (setq ss (ssget '((0 . "line,arc,*polyline"))))
    
14.   (if ss
    
15.     (progn
    
16.       (setq ssl (GXL-SEL-SS->LIST ss))
    
17.       (setq pl (apply 'append (setq lst (mapcar '(lambda (a)(list (vlax-curve-getStartPoint a) (vlax-curve-getendPoint a))) ssl))))
    
18.       (setq ll (apply 'mapcar (cons 'min pl))
    
19.       ur (apply 'mapcar (cons 'max pl))
    
20.       )
    
21.       (command "_circle" "2p" "_non" (trans ll 0 1) "_non" (trans ur 0 1))
    
22.       (setq cir (entlast))
    
23.       (setq cp (cdr (assoc 10 (entget cir))))
    
24.       (setq lst
    
25.        (mapcar
    
26.          '(lambda (x)
    
27.       (if (apply 'gxl-Clockwise-p (cons cp x))
    
28.         (reverse x)
    
29.         x
    
30.         )
    
31.       )
    
32.          lst
    
33.          )
    
34.       lst
    
35.        (vl-sort
    
36.          lst
    
37.          '(lambda (a b)
    
38.       (< (vlax-curve-getParamAtPoint cir (vlax-curve-getclosestpointto cir (car a)))
    
39.          (vlax-curve-getParamAtPoint cir (vlax-curve-getclosestpointto cir (car b)))
    
40.          )
    
41.       )
    
42.          )
    
43.       )
    
44.       (setq pts1 (car lst)
    
45.       lst (append (cdr lst) (list pts1))
    
46.       )
    
47.       (while lst
    
48.   (setq pts2 (car lst)
    
49.         lst (cdr lst)
    
50.         )
    
51.   (if (not (equal (cadr pts1) (car pts2) 1e-3))
    
52.     (progn
    
53.       (command "_line" "_non" (trans (cadr pts1) 0 1) "_non" (trans (car pts2) 0 1) "")
    
54.       (ssadd (entlast) ss)
    
55.       )
    
56.     )
    
57.   (setq pts1 pts2)
    
58.   )
    
59.       
    
60.       (command "pedit" "m" ss "" "j" 1e-3 "")
    
61.       (setvar 'peditaccept peditaccept)
    
62.       (setvar 'cmdecho cmdecho)
    
63.       (entdel cir)
    
64.       )
    
65.     )
    
66.   )
    
67. 
    
68. ;;;选择集转为图元列表
    
69. (defun gxl-Sel-SS->List (ss / i s)
    
70.   (if ss
    
71.     (repeat (setq i (sslength ss))
    
72.       (setq s (cons (ssname ss (setq i (1- i))) s))
    
73.       )
    
74.     )
    
75.   )
    
76. ;;(gxl-Clockwise-p p1 p2 p3)判断三点是否顺时针
    
77. (defun gxl-Clockwise-p ( p1 p2 p3 )
    
78.     (<
    
79.         (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
    
80.         (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
    
81.     )
    
82. )

;;串接封闭线,By Gu_xl 2013.08.15<br /> ;;一次选择一组要连线的实体<br /> (defun c:MyJoin (/ *error* CMDECHO PEDITACCEPT SS SSL PL LST LL UR CIR CP PTS1 PTS2) <br />   (defun *error* (s)<br />     (setvar 'peditaccept peditaccept)<br />       (setvar 'cmdecho cmdecho)<br />     (princ s)<br />     )<br />   (setq cmdecho (getvar 'cmdecho))<br />   (setvar 'cmdecho 0)<br />   (setq peditaccept (getvar 'peditaccept))<br />   (setvar 'peditaccept 1)<br />   (setq ss (ssget '((0 . "line,arc,*polyline"))))<br />   (if ss<br />     (progn<br />       (setq ssl (GXL-SEL-SS->LIST ss))<br />       (setq pl (apply 'append (setq lst (mapcar '(lambda (a)(list (vlax-curve-getStartPoint a) (vlax-curve-getendPoint a))) ssl))))<br />       (setq ll (apply 'mapcar (cons 'min pl))<br />       ur (apply 'mapcar (cons 'max pl))<br />       )<br />       (command "_circle" "2p" "_non" (trans ll 0 1) "_non" (trans ur 0 1))<br />       (setq cir (entlast))<br />       (setq cp (cdr (assoc 10 (entget cir))))<br />       (setq lst<br />        (mapcar<br />          '(lambda (x)<br />       (if (apply 'gxl-Clockwise-p (cons cp x))<br />         (reverse x)<br />         x<br />         )<br />       )<br />          lst<br />          )<br />       lst<br />        (vl-sort<br />          lst<br />          '(lambda (a b)<br />       (< (vlax-curve-getParamAtPoint cir (vlax-curve-getclosestpointto cir (car a)))<br />          (vlax-curve-getParamAtPoint cir (vlax-curve-getclosestpointto cir (car b)))<br />          )<br />       )<br />          )<br />       )<br />       (setq pts1 (car lst)<br />       lst (append (cdr lst) (list pts1))<br />       )<br />       (while lst<br />   (setq pts2 (car lst)<br />         lst (cdr lst)<br />         )<br />   (if (not (equal (cadr pts1) (car pts2) 1e-3))<br />     (progn<br />       (command "_line" "_non" (trans (cadr pts1) 0 1) "_non" (trans (car pts2) 0 1) "")<br />       (ssadd (entlast) ss)<br />       )<br />     )<br />   (setq pts1 pts2)<br />   )<br />       <br />       (command "pedit" "m" ss "" "j" 1e-3 "")<br />       (setvar 'peditaccept peditaccept)<br />       (setvar 'cmdecho cmdecho)<br />       (entdel cir)<br />       )<br />     )<br />   )<br /> <br /> ;;;选择集转为图元列表<br /> (defun gxl-Sel-SS->List (ss / i s)<br />   (if ss<br />     (repeat (setq i (sslength ss))<br />       (setq s (cons (ssname ss (setq i (1- i))) s))<br />       )<br />     )<br />   )<br /> ;;(gxl-Clockwise-p p1 p2 p3)判断三点是否顺时针<br /> (defun gxl-Clockwise-p ( p1 p2 p3 )<br />     (<<br />         (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))<br />         (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))<br />     )<br /> )