求一个源码：根据现有闭合内空 自动生成矩形或者多段线

酷酷提

我上传的图片全是交叉的直线
现在就是希望能够解决：我框选中所有线条以后，根据现有的闭合空间，自动生成矩形或者多段线
比如我图片里面就有6个形状大小不一的闭合空间，就自动生成6个矩形或者多段线。

xj6019

更新一下！！

(defun c:NM (/ area lst p1 p2 s ss2list ygs_brk_int_cur)
        (defun area(ent / obj-vla obj-area)
                (setq obj-vla (vlax-ename->vla-object ent))
                (setq obj-area (vla-get-Area obj-vla))
        )
        (defun ss2list (SS)(vl-remove-if-not '(lambda(x)(= 'ENAME (type x))) (mapcar 'cadr (ssnamex SS))))
        (defun ygs_brk_int_cur(ss / BLYZ GS I PT SJD SJD_PT SS2 UN_SURF X)
                (setq gs(sslength ss) i 0)
                (repeat gs
                        (command "extrude" "MO" "SU" (ssname ss i)"" 2 )
                        (vla-delete (vlax-ename->vla-object(ssname ss i)))
                        (setq i(1+ i))
                )
                (command "union" (ssget "A"'((0 . "EXTRUDEDSURFACE"))) "" )
                (setq un_surf(entlast)
                        sjd_pt(cdr(last(ssnamex ss)))
                        sjd nil
                )
                (mapcar'(lambda(x)(setq sjd(cons (car(cdr x))sjd)))sjd_pt)
                (entmakex (append (list '(0 . "LWPOLYLINE")
                                                                                                '(100 . "AcDbEntity")
                                                                                                '(100 . "AcDbPolyline")
                                                                                                '(62 . 0)
                                                                                                (cons 90 (length sjd))
                                                                                                (cons 70 1)
                                                                                        )
                                                                (mapcar '(lambda (pt) (cons 10 pt)) sjd)
                                                        )
                )
                (command "convtosurface" (entlast) ""
                        "_intersect" (entlast) un_surf ""
                )
        )
        (setq p1 (getpoint "\n框选第一点:")
                p2 (getcorner p1 "\n框选第二点:")
        )
        (setq  s(ssget "C" P1  P2 '((0 . "*LINE,ARC")))
        )
        (ygs_brk_int_cur s)
        (setq s(ssget "C" P1  P2 '((0 . "*LINE,ARC"))))
        (command ".region" s "")
        (if(setq s(ssget "C" P1  P2 '((0 . "*LINE,ARC"))))
                (command  "erase"  s "")
        )
        (if(setq s(ssget "C" P1  P2 '((0 . "REGION"))))
                (progn
                        (setq lst(ss2list s))
                        (entdel (car(vl-sort lst '(lambda (x1 x2) (> (area x1) (area x2))))))
                        (mapcar '(lambda(x)
                                                                 (vla-explode (vlax-ename->vla-object  x))
                                                                 (entdel x)
                                                                 (setq  s1(ssget "C" P1  P2 '((0 . "*LINE,ARC"))))
                                                                 (command "pedit" "m" s1 "" "y" "j" "" ""); 合并
                                                         )
                                (ss2list (ssget "C" P1  P2 '((0 . "REGION"))))
                        )
                )
        )
        (princ)
)

酷酷提

还有就是请问一下，用多段线画的矩形，和直接用矩形命令画的矩形，有没有什么很明显的功能不同呢？如果能能直接生成多段线是不是会更好？以后遇到直线画的梯形、三角形也能直接生成闭合的多段线

自贡黄明儒

用bo试试      

酷酷提

自贡黄明儒 发表于 2022-4-27 07:51
用bo试试

谢谢大大，bo可以是可以，但是需要一个空一个去空点击，如果遇到方块比较小的时候就比较麻烦了，需要不断的放大缩小去点选，如果有lsp直接框选就更好了

自贡黄明儒

酷酷提 发表于 2022-4-27 08:21
谢谢大大，bo可以是可以，但是需要一个空一个去空点击，如果遇到方块比较小的时候就比较麻烦了，需要不断 ...

(COMMAND "_.BO             呀，不是还有个选择对象吗？

yanchao316

CAD2012以上，框选，输入J确认

paulpipi

怎么Cad2008运行不了，提示无效的选择

xyp1964

酷酷提

xyp1964 发表于 2022-4-27 14:17

老师，不是偏移的意思，是按照原闭合的内空尺寸变化为矩形哈。。。