明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1076|回复: 2

[基础] 请高手帮忙修改批量框剪线程序

[复制链接]
发表于 2013-7-3 11:31:00 | 显示全部楼层 |阅读模式
;;此程序来自mjtd.com
;;本人lisp不是太精通,请高手把下面的程序改为批量剪切“框内”的线 ,先谢谢了!
(defun c:mt(); / e1 pt x ptx pty l1 i p1 p2 p1x p1y point count  rect e0
(setvar "osmode" 0)
(setq l1 nil)
(setq i 0)
(setq rect (car (entsel "\n请选择需剪切的矩形:")))
(setq e0 (entget rect))
(while (setq x (nth i e0))
(if (= (car x) 10)
(progn
(setq ptx (nth 1 x))
(setq pty (nth 2 x))
(setq x (list ptx pty))
(setq l1 (cons x l1))
)
)
(setq i (1+ i))
)
(reverse l1)
(setq p1 (car l1))
(setq p1x (nth 0 p1))
(setq p1y (nth 1 p1))
(setq count 0)
(repeat 3
(setq count (+ count 1))
(setq pt (nth count l1))
(setq ptx (nth 0 pt))
(setq pty (nth 1 pt))
(setq point (mapcar '+ p1 pt))
(setq point (mapcar '/ point '(-1 -1 -1)))
(if
(and (/= (nth 0 point) p1x)
(/= (nth 0 point) ptx)
(/= (nth 1 point) p1y)
(/= (nth 1 point) pty)
)
(setq p point)
)
)
(setq l1 nil)
(command "offset" 0.001 rect p "")
(setq e0 (entlast))
(setq e1 (entget e0))
(princ e1)
(setq i 0)
(while (setq x (nth i e1))
(if (= (car x) 10)
(progn
(setq ptx (nth 1 x))
(setq pty (nth 2 x))
(setq x (list ptx pty))
(setq l1 (cons x l1))
)
)
(setq i (1+ i))
)
(reverse l1)
(setq p1 (car l1))
(setq p2 p1)
(command "erase" e0 "")
(setq count 0)
(repeat 3
(setq count (+ count 1))
(setq pt (nth count l1))
(command "trim" rect "" "f" p1 pt "" "")
(setq p1 pt)
)
(command "trim" rect "" "f" p1 p2 "" "")
(setvar "osmode" 687)
)

"觉得好,就打赏"
还没有人打赏,支持一下
 楼主| 发表于 2013-7-3 13:14:22 | 显示全部楼层
;;为什么这样就可以了?
(defun c:mt1(); / e1 pt x ptx pty l1 i p1 p2 p1x p1y point count  rect e0
(setvar "osmode" 0)
(setq l1 nil)
(setq i 0)
(setq rect (car (entsel "\n请选择需剪切的矩形:")))
(setq e0 (entget rect))
(while (setq x (nth i e0))
(if (= (car x) 10)
(progn
(setq ptx (nth 1 x))
(setq pty (nth 2 x))
(setq x (list ptx pty))
(setq l1 (cons x l1))
)
)
(setq i (1+ i))
)
(reverse l1)
(setq p1 (car l1))
(setq p1x (nth 0 p1))
(setq p1y (nth 1 p1))
(setq count 0)
(repeat 3
(setq count (+ count 1))
(setq pt (nth count l1))
(setq ptx (nth 0 pt))
(setq pty (nth 1 pt))
(setq point (mapcar '+ p1 pt))
(setq point (mapcar '/ point '(2.0 2.0 2.0)))
(if
(and (/= (nth 0 point) p1x)
(/= (nth 0 point) ptx)
(/= (nth 1 point) p1y)
(/= (nth 1 point) pty)
)
(setq p point)
)
)
(command "undo" "begin" "")
(setq l1 nil)
(command "offset" 0.001 rect p "")
(setq e0 (entlast))
(setq e1 (entget e0))
(princ e1)
(setq i 0)
(while (setq x (nth i e1))
(if (= (car x) 10)
(progn
(setq ptx (nth 1 x))
(setq pty (nth 2 x))
(setq x (list ptx pty))
(setq l1 (cons x l1))
)
)
(setq i (1+ i))
)
(reverse l1)
(setq p1 (car l1))
(setq p2 p1)
(command "erase" e0 "")
(setq count 0)
(repeat 3
(setq count (+ count 1))
(setq pt (nth count l1))
(command "trim" rect "" "f" p1 pt "" "")
(setq p1 pt)
)
(command "trim" rect "" "f" p1 p2 "" "")
  (command "undo" "end" "")
(setvar "osmode" 687)
)








发表于 2013-7-3 14:28:50 | 显示全部楼层
真的能行?我是没得到正确结果!p1、p2为同一点,能trim?
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-11-25 06:58 , Processed in 0.184945 second(s), 30 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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