关于XCLIP遮罩块的裂解问题
本帖最后由 尘缘一生 于 2023-12-17 01:00 编辑从得到一个这样的图，发现这个问题，具说，又不少的图纸这么作，特别室内、装潢行业。
发上我的尝试，如何才能解决，
是不是所有102,360组码都是画图的人用XCLIP形成的呢？
[*];;炸XCLIP-blk （三领尝试）
[*];;速度慢（达不到使用级别），结果还可以理想
[*](defun c:tt (/ ss ss1 nam e n pls)
[*](setq ss (ssget ":S" '((0 . "INSERT"))))
[*](repeat (setq n (sslength ss))
[*] (setq nam (ssname ss (setq n (1- n))))
[*] (if (dxf1 nam 102)
[*] (progn
[*] (command "_.XCLIP" nam "" "P");边界多段线产生
[*] (setq e (entlast) pls (getpt (ssadd e))) ;边界与其点表
[*] (ss-re120 (ssadd nam))
[*] ;(command "_.XCLIP" nam "" "D");此句作用同上一句，二选一
[*] (vl-catch-all-apply 'exp-blk (list (entlast)));炸块集成系统
[*] (vl-catch-all-apply 'slexpline (list (last_ent e)));线类裂解系统
[*]
[*] (vl-catch-all-apply 'sl_break_with (list (ssadd e (last_ent e)) t));交点断开系统
[*] (setq ss1 (last_ent e)) ;;炸-断后总集
[*] (command "_.COPY" (ssget "WP" pls) "" "_non" '(0 0) "_non" '(0 0)) ;;窗口部分原位拷贝
[*] (entdel e);删除边界
[*] (sl:-erase ss1) ;删除
[*] )
[*] )
[*])
[*])
[*];;选择集去除120组码----(一级)----
[*](defun ss-re120 (ss / n nam entl entn)
[*](repeat (setq n (sslength ss))
[*] (setq nam (ssname ss (setq n (1- n))) entl (entget nam) entn nil)
[*] (foreach m entl
[*] (if (and (/= (car m) 102) (/= (car m) 360))
[*] (setq entn (cons m entn))
[*] )
[*] )
[*] (if entn
[*] (progn
[*] (setq entn (reverse entn))
[*] (entdel nam)
[*] (entmake entn)
[*] )
[*] )
[*])
[*])
附件为这种块的图，大家兴趣看如何完美处理。
XCLI相关函数
支持，顶起！
[*];炸XCLIP块
[*];MODIFY 三领设计 QQ:15290049
[*](defun c:tt (/ wmffile p1 p2 p11 p22 ss1 dist oldwmfbk nam p0)
[*](defun slhas (TYPE_1 NAME)
[*] (if (not
[*] (vl-catch-all-error-p
[*] (vl-catch-all-apply 'vla-item (list ((eval (read (strcat "vla-get-" TYPE_1))) *AcDocument*) NAME))
[*] )
[*] )
[*] t
[*] )
[*])
[*];;-------------------
[*](princ (slmsg "\n WMF输出--矩形范围输出" "\n WMF块--痻璖瞅块" "\ n WMF output - rectangular range output"))
[*](setq file_path (strcat sl-path0 "\\tmp"))
[*](if (findfile file_path) (princ) (vxmakedirectory file_path))
[*](setq wmffile (strcat file_path "\\WMF_" (slsjqs)))
[*](while (findfile (strcat wmffile ".wmf"))
[*] (setq wmffile (strcat file_path "\\WMF_" (slsjqs)))
[*])
[*](if (setq p1 (getpoint (slmsg "\n 请指定矩形框第一点:" "\n 叫﹚痻材翴:" "\n Please specify the first point of the rectangular box:")))
[*] (if (setq p2 (getcorner p1 (slmsg "\n 请指矩形框定对角点:" "\n 叫痻﹚癸à翴:" "\n Please indicate the diagonal point of the rectangular frame:")))
[*] (if (setq ss1 (ssget "W" p1 p2))
[*] (progn
[*] (setq oldwmfbk (getvar "WMFBKGND"))
[*] (setvar "WMFBKGND" 0);;清除底色
[*] (setq dist 5);;这个是WMF的边界框
[*] (if (slhas "LAYOUTS" "Temporary layout")
[*] (princ)
[*] (command "layout" "n" "Temporary layout") ;创建并切换布局
[*] )
[*] (command "_.layout" "s" "Temporary layout")
[*] (command "tilemode" "0")
[*] (command "erase" (ssget "X" '((0 . "VIEWPORT"))) "") ;删除所有布局视口
[*] (command "mview"
[*] (setq p11 (list (- (car p1) dist) (- (cadr p1) dist) 0))
[*] (setq p22 (list (+ (car p2) dist) (+ (cadr p2) dist) 0))
[*] )
[*] (command "_.zoom" "w" p11 p22) ;不缩放的话就找不到可用于激活的视口了
[*] (if (= (getvar "CVPORT") 1) (command "mspace")) ;激活视口;(command "pspace");切换到图纸空间
[*] (command "_.zoom" "w" p11 p22) ;缩放
[*] (if (not (vl-catch-all-error-p (vl-catch-all-apply '(lambda () (command "wmfout" wmffile ss1 "")))))
[*] (progn
[*] (sl:-erase ss1) ;删除
[*] (command "tilemode" "1") ;切换回模型空间
[*] (if (slhas "LAYOUTS" "Temporary layout")
[*] (command "_.layout" "D" "Temporary layout") ;删除临时布局
[*] )
[*] (command "_.wmfin" wmffile 1 1 1 0)
[*] (setq nam (entlast) p0 (e9pt nam 5))
[*] (command "_.MOVE" nam "" "non" p0 PAUSE)
[*] (vl-catch-all-apply 'exp-blk (list nam));炸块
[*] )
[*] )
[*] (setvar "WMFBKGND" oldwmfbk)
[*] )
[*] )
[*] )
[*])
[*])
朋友，你这是要实现多级嵌套块儿由wipeout变为真正的修剪哈 guosheyang 发表于 2023-12-23 10:25
朋友，你这是要实现多级嵌套块儿由wipeout变为真正的修剪哈
尝试解决含有XCLIP实体的裂解问题
;炸开(含有Xclip块)的实体集---(一级)----
;MODIFY 三领设计;QQ:15290049
(defun exp-xclip-blk (ss / file_path wmffile p1 p2 nam p0 e_lst lst d1 d2)
(defun slhas (TYPE_1 NAME)
(if (not
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-item (list ((eval (read (strcat "vla-get-" TYPE_1))) *AcDocument*) NAME))
)
)
t
)
)
;;-------------------
(princ (slmsg "\n Xclip块裂解-->>" "\n Xclip遏吊秆-->>" "\ n Xclip block Explode-->"))
(setq file_path (strcat sl-path0 "\\tmp"))
(if (findfile file_path) (princ) (vxmakedirectory file_path))
(setq wmffile (strcat file_path "\\WMF_" (slsjqs)))
(while (findfile (strcat wmffile ".wmf"))
(setq wmffile (strcat file_path "\\WMF_" (slsjqs)))
)
(setq lst (slget-box ss) p1 (car lst) p2 (cadr lst) d1 (distance p1 p2))
(setq e_lst (sysvar '("WMFBKGND" "TILEMODE")))
(setvar "WMFBKGND" 0);;清除底色
(if (slhas "LAYOUTS" "Temporary layout")
(princ)
(command "layout" "n" "Temporary layout") ;创建并切换布局
)
(command "_.layout" "s" "Temporary layout")
(setvar "tilemode" 0)
(command "erase" (ssget "X" '((0 . "VIEWPORT"))) "") ;删除所有布局视口
(command "mview" p1 p2)
(vla-ZoomWindow *ACAD* (vlax-3d-point p1) (vlax-3d-point p2))
(if (= (getvar "CVPORT") 1) (command "mspace")) ;激活视口;(command "pspace");切换到图纸空间
(vla-ZoomWindow *ACAD* (vlax-3d-point p1) (vlax-3d-point p2))
(if (not (vl-catch-all-error-p (vl-catch-all-apply '(lambda () (command "wmfout" wmffile ss "")))))
(progn
(sl:-erase ss) ;删除
(setvar "tilemode" 1) ;切换回模型空间
(if (slhas "LAYOUTS" "Temporary layout")
(command "_.layout" "D" "Temporary layout") ;删除临时布局
)
(command "_.wmfin" wmffile 1 1 1 0)
(setq nam (entlast) lst (e9pt nam nil) p0 (nth 4 lst) d2 (distance (car lst) (nth 8 lst)))
(command "SCALE" nam "" p0 (/ d1 d2) "_.MOVE" nam "" "non" p0 PAUSE)
(vl-catch-all-apply 'exp-blk (list nam));炸块
)
)
(mapcar 'eval e_lst)
(princ)
)
尘缘一生 发表于 2023-12-24 02:00
尝试解决含有XCLIP实体的裂解问题
这个可以直接使用吗？启动命令是？
页:
[1]