设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 关于XCLIP遮罩块的裂解问题
返回列表 发新帖
查看: 1073|回复: 6

[讨论] 关于XCLIP遮罩块的裂解问题

  [复制链接]
尘缘一生
发表于 2023-12-17 00:38:01 | 显示全部楼层 |阅读模式
本帖最后由 尘缘一生 于 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)
  •       )
  •     )
  •   )
  • )

附件为这种块的图，大家兴趣看如何完美处理。


本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x
"觉得好，就打赏"
打赏
共1人打赏
回复

使用道具 举报

尘缘一生
 楼主| 发表于 2023-12-18 20:23:04 | 显示全部楼层
XCLI相关函数





本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x
回复 支持 反对

使用道具 举报

尘缘一生
 楼主| 发表于 2023-12-23 10:01:48 | 显示全部楼层
  • ;炸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)
  •         )
  •       )
  •     )
  •   )
  • )

回复 支持 反对

使用道具 举报

guosheyang
发表于 2023-12-23 10:25:49 | 显示全部楼层
朋友，你这是要实现多级嵌套块儿  由wipeout变为真正的修剪哈
回复 支持 反对

使用道具 举报

尘缘一生
 楼主| 发表于 2023-12-24 02:00:39 | 显示全部楼层
guosheyang 发表于 2023-12-23 10:25
朋友，你这是要实现多级嵌套块儿  由wipeout变为真正的修剪哈

尝试解决含有XCLIP实体的裂解问题

  2. ;炸开(含有Xclip块)的实体集---(一级)----
  3. ;MODIFY 三领设计;QQ:15290049
  4. (defun exp-xclip-blk (ss / file_path wmffile p1 p2 nam p0 e_lst lst d1 d2)
  5.   (defun slhas (TYPE_1 NAME)
  6.     (if (not
  7.           (vl-catch-all-error-p
  8.             (vl-catch-all-apply 'vla-item (list ((eval (read (strcat "vla-get-" TYPE_1))) *AcDocument*) NAME))
  9.           )
  10.         )
  11.       t
  12.     )
  13.   )
  14.   ;;-------------------
  15.   (princ (slmsg "\n Xclip块裂解-->>" "\n Xclip遏吊秆-->>" "\ n Xclip block Explode-->"))
  16.   (setq file_path (strcat sl-path0 "\\tmp"))
  17.   (if (findfile file_path) (princ) (vxmakedirectory file_path))
  18.   (setq wmffile (strcat file_path "\\WMF_" (slsjqs)))
  19.   (while (findfile (strcat wmffile ".wmf"))
  20.     (setq wmffile (strcat file_path "\\WMF_" (slsjqs)))
  21.   )
  22.   (setq lst (slget-box ss) p1 (car lst) p2 (cadr lst) d1 (distance p1 p2))
  23.   (setq e_lst (sysvar '("WMFBKGND" "TILEMODE")))
  24.   (setvar "WMFBKGND" 0);;清除底色
  25.   (if (slhas "LAYOUTS" "Temporary layout")
  26.     (princ)
  27.     (command "layout" "n" "Temporary layout") ;创建并切换布局
  28.   )
  29.   (command "_.layout" "s" "Temporary layout")
  30.   (setvar "tilemode" 0)
  31.   (command "erase" (ssget "X" '((0 . "VIEWPORT"))) "") ;删除所有布局视口
  32.   (command "mview" p1 p2)
  33.   (vla-ZoomWindow *ACAD* (vlax-3d-point p1) (vlax-3d-point p2))
  34.   (if (= (getvar "CVPORT") 1) (command "mspace")) ;激活视口;(command "pspace");切换到图纸空间
  35.   (vla-ZoomWindow *ACAD* (vlax-3d-point p1) (vlax-3d-point p2))
  36.   (if (not (vl-catch-all-error-p (vl-catch-all-apply '(lambda () (command "wmfout" wmffile ss "")))))
  37.     (progn
  38.       (sl:-erase ss) ;删除
  39.       (setvar "tilemode" 1) ;切换回模型空间
  40.       (if (slhas "LAYOUTS" "Temporary layout")
  41.         (command "_.layout" "D" "Temporary layout") ;删除临时布局
  42.       )
  43.       (command "_.wmfin" wmffile 1 1 1 0)
  44.       (setq nam (entlast) lst (e9pt nam nil) p0 (nth 4 lst) d2 (distance (car lst) (nth 8 lst)))
  45.       (command "SCALE" nam "" p0 (/ d1 d2) "_.MOVE" nam "" "non" p0 PAUSE)
  46.       (vl-catch-all-apply 'exp-blk (list nam));炸块
  47.     )
  48.   )
  49.   (mapcar 'eval e_lst)
  50.   (princ)
  51. )

回复 支持 反对

使用道具 举报

jh3030912
发表于 2023-12-24 18:10:42 来自手机 | 显示全部楼层
尘缘一生 发表于 2023-12-24 02:00
尝试解决含有XCLIP实体的裂解问题

这个可以直接使用吗？启动命令是？
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-11-26 01:42 , Processed in 0.177788 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表