CAD默认的边界创建BOUNDARY命令，点就行了
KO你 发表于 2022-11-14 22:25
CAD默认的边界创建BOUNDARY命令，点就行了
我也知道是点，就是像有个插件直接实现，就可以节省时间哇
999999 发表于 2022-11-14 22:34
我也知道是点，就是像有个插件直接实现，就可以节省时间哇
可以按面积大小控制所要的区域，代码已经上传
xyp1964 发表于 2022-11-15 12:36
可以按面积大小控制所要的区域，代码已经上传
好的哦，谢谢院长大人
仅针对此例
(defun xty-get-dxf (code en) (cdr (assoc code (entget en))))
(defun xty-get-plptlist(en fuzz /)
(xty-L-delsames
(mapcar 'cdr
(vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget en))
)
fuzz
)
)
(defun xty-get-intpts (ss fuzz / lst obj boj1 ptlst pts)
(setq lst (xty-tr-ss2lst ss nil))
(while lst
(setq obj (car lst)
lst (cdr lst)
)
(foreach obj1 lst
(setq ptlst (if (setq pts(xty-tr-value2list
(vlax-invoke-method
obj
'intersectwith
obj1
acextendnone
)
)
)
(cons (xty-L-cai pts 3) ptlst)
ptlst
)
)
)
)
(if ptlst
(xty-L-delsames (apply 'append ptlst) fuzz)
)
)
(defun xty-tr-value2list (value)
(setqvalue (vl-catch-all-apply
(function vlax-safearray->list)
(list (vlax-variant-value value))
)
)
(if (= (type value) (function LIST))
value
nil
)
)
(defun xty-tr-ss2lst (ss form / n en lst)
(repeat (setq n (sslength ss))
(setq en (ssname ss (setq n (1- n))))
(setq lst (cons en lst))
)
(setq lst(reverse lst))
(if form lst (mapcar(function vlax-ename->vla-object)lst))
)
(defun xty-L-delsames(lst fuzz / start new)
(while (setq start (car lst))
(if(vl-some '(lambda (x) (equal start x fuzz)) new)
nil
(setq new (cons start new))
)
(setq lst (cdr lst))
)
(setq new (reverse new))
new
)
(defun xty-L-cai(lst n / a lst1 lst2)
(setq a (length lst))
(if (/= 0 (setq a (rem a n)))
(repeat a (setq lst (append lst (list nil)))))
(while lst
(repeat n
(setq lst1 (cons (car lst) lst1)
lst (cdr lst)
)
)
(setq lst2 (cons (reverse lst1) lst2)
lst1 nil
)
)
(reverse lst2)
)
(defun c:tt (/ dis en lst md old ss)
(setq md 20) ;_根据实际需要，最大边框宽
(setqold (getvar 'clayer)
ss(ssget '((0 . "*line")))
lst (vl-remove-if-not
'(lambda (x) (= "LWPOLYLINE" (xty-get-dxf 0 x)))
(xty-tr-ss2lst ss t)
)
lst (apply 'append
(mapcar '(lambda (x) (xty-get-plptlist x 1e-6)) lst)
)
lst (xty-L-delsames (append lst (xty-get-intpts ss 1e-6)) 1e-6)
)
(setvar 'clayer "YB2")
(foreach n lst
(if(setq en (bpoly(mapcar '+ n (list (* 0.5 md) (* 0.5 md)))
ss
'(0 0 0)
)
)
(progn (setq dis (xty-get-plptlist en 1e-6)
dis (mapcar '(lambda (x y) (distance x y)) dis (cdr dis))
dis (vl-sort dis '<)
dis (car dis)
)
(if (or (> md dis) (equal md dis 1e-6))
(entdel en)
)
)
)
)
(setvar 'clayer old)
)
x_s_s_1 发表于 2022-11-15 16:44
仅针对此例
大神您好，非常谢谢大神的参与，我感觉可以先全部面域一遍，然后再筛选最短边的多边线进行删除，最终得到的就是想要的
999999 发表于 2022-11-15 17:46
大神您好，非常谢谢大神的参与，我感觉可以先全部面域一遍，然后再筛选最短边的多边线进行删除，最终得到 ...
大神您好，我复制的代码是这样的，运行出现这种情况呢
999999 发表于 2022-11-15 17:46
大神您好，非常谢谢大神的参与，我感觉可以先全部面域一遍，然后再筛选最短边的多边线进行删除，最终得到 ...
大神您好，您看一下底下我复制您的代码发出的附件
999999 发表于 2022-11-16 11:55
大神您好，我复制的代码是这样的，运行出现这种情况呢
我试了几次没有反应呢
999999 发表于 2022-11-17 11:41
我试了几次没有反应呢
你没复制对吧，我也是复制的网页代码，没问题啊