xyp1964 发表于 2022-11-26 13:49
;; 神经元选择，代码需要e派工具箱的支持
谢谢帮忙，可是没有安装您这个工具箱
本帖最后由 cq4920 于 2022-11-26 15:27 编辑
sunny_8848 发表于 2022-11-26 13:56
谢谢帮忙，可是没有安装您这个工具箱
搜索：分堆
不用考虑他原始的样子，直接给她们各自重新套框，图层为图框，打印不可见色，就解决了
cq4920 发表于 2022-11-26 15:22
搜索：分堆
不用考虑他原始的样子，直接给她们各自重新套框，图层为图框，打印不可见色，就解决了
分堆的方法效率很高，目前在上传的图纸中暂时发现多出一根线条
本帖最后由 sunny_8848 于 2022-11-26 16:39 编辑
;下面分堆的代码效率很高，限制也少。可惜矩形不是在图框层
(defun c:tt (/ wkjl ss lst obj maxp minp flst nlst maxpx maxpy pt )
(IF (NULL *wkjl) (setq *wkjl 30.0))
(setq wkjl (GETREAL (strcat "\n外扩距离<" (rtos *wkjl 2 2) ">:")))
(if (NULL wkjl) (setq wkjl *wkjl) (setq *wkjl wkjl))
(setq ss (ssget))
(setqlst
(mapcar '(lambda (x)
(setq obj (vlax-ename->vla-object x))
(vla-getboundingbox obj 'minp 'maxp)
(setq
maxp (mapcar '* '(1.0 1.0) (vlax-safearray->list maxp))
)
(setq
minp (mapcar '* '(1.0 1.0) (vlax-safearray->list minp))
)
(list x (car minp) (car maxp) (cadr minp) (cadr maxp))
)
(vl-remove-if-not
'(lambda (x) (= 'ENAME (type x)))
(apply 'append (ssnamex ss))
)
)
)
(setqflst (lambda (lst key)
(if lst
(if key
(progn
(setq nlst (list (list (caar lst)
(cadddr (car lst))
(last (car lst))
))
maxpx (caddar lst)
lst (cdr lst)
)
(while (and lst (<= (cadar lst) maxpx))
(setq nlst(cons (list (caar lst)
(cadddr (car lst))
(last (car lst))
)
nlst
)
maxpx (max maxpx (caddar lst))
lst (cdr lst)
)
)
(cons nlst (flst lst key))
)
(progn
(setq nlst (list (caar lst))
maxpy (caddar lst)
lst (cdr lst)
)
(while (and lst (<= (cadar lst) maxpy))
(setq nlst(cons (caar lst) nlst)
maxpy (max maxpy (caddar lst))
lst (cdr lst)
)
)
(cons nlst (flst lst key))
)
)
)
)
)
(setq
lst
(apply
'append
(mapcar
'(lambda (wlst)
(flst (vl-sort wlst '(lambda (a b) (< (cadr a) (cadr b))))
nil
)
)
(flst (vl-sort lst '(lambda (a b) (< (cadr a) (cadr b)))) t)
)
)
)
(mapcar
'(lambda (x)
(setq pt (apply
'append
(mapcar
'(lambda (ent)
(vla-getboundingbox (vlax-ename->vla-object ent) 'minp 'maxp)
(list (mapcar '* '(1.0 1.0) (vlax-safearray->list maxp))
(mapcar '* '(1.0 1.0) (vlax-safearray->list minp))
)
)
x
)
))
(setq minp (mapcar '- (apply 'mapcar (cons 'min pt)) (list wkjl wkjl)))
(setq maxp (mapcar '+ (apply 'mapcar (cons 'max pt)) (list wkjl wkjl)))
(entmake(list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(90 . 4)
'(70 . 1)
'(62 . 1)
(cons 10 minp)
(cons 10 (list (car minp) (cadr maxp)))
(cons 10 maxp)
(cons 10 (list (car maxp) (cadr minp)))
)
)
)
lst
)
(princ)
)
本帖最后由 lee50310 于 2022-11-28 08:29 编辑
sunny_8848 发表于 2022-11-26 16:37
;下面分堆的代码效率很高，限制也少。可惜矩形不是在图框层
(defun c:tt (/ wkjl ss lst obj maxp minp...
如果不考慮程式完成後須1. 刪除原本外框的舊線段
2. 刪除分堆程式所產生面積為零的重疊線段
只需修改程式1處及新增幾段程式便可很快完成
谢谢。您给的最后一个文件已经很方便了
本帖最后由 lee50310 于 2022-11-28 08:30 编辑
若要考慮 上述2點
那就需多花些時間來排除
本帖最后由 lee50310 于 2022-11-27 15:08 编辑
了解! 收到...
lee50310 发表于 2022-11-26 08:39
將外圍線替換為矩形框程式 tt5
執行指令:tt5
很好用，谢谢lee分享。
如果可以批量闭合更好
lxl217114 发表于 2022-11-29 16:28
很好用，谢谢lee分享。
如果可以批量闭合更好
批量 將外圍線替換為矩形框
程式已寫好放置 5樓