[求助]谁帮我改下这个LISP源代码呀！感谢！！

chinaf12

我现在有个“矩形框内裁剪”源码，现在我想改成"圆内裁剪"源码，能否帮我改一下这个源码。谢谢！ 另外可否增加一次性多选，就是一次性对CAD图内所有圆内的线进行剪切掉。 “矩形框内裁剪”源码如下：   (defun c:tt (/ rect e0 e1 pt x ptx pty l1 i p1 p2 p1x p1y point count) (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) ) ) (setq l1 nil) (command "offset" 5 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) )

ZZXXQQ

这是以前写的。

游客，本帖隐藏的内容需要发帖数高于 2 才可浏览，你当前发帖数只有 0

5061220

学习！谢谢猫版主和LZ!

chinaf12

谢谢2楼，你的这个源代码我用过，但是我的图圆很多，这个源代码在圆少时很好用，但图里圆很多的时候不好用，速度也很慢。现在我想要这个矩形那种可以通过点击圆就可以剪切的那种。可以做到吗？谢谢。

5061220

chinaf12发表于2009-8-23 10:40:00谢谢2楼，你的这个源代码我用过，但是我的图圆很多，这个源代码在圆少时很好用，但图里圆很多的时候不好用，速度也很慢。现在我想要这个矩形那种可以通过点击圆就可以剪切的那种。可以做到吗？

当然能做到了！这世上没有做不到的，只有想不到的哦！

chinaf12

楼上的，可否写一个呀。我对LISP不熟悉。谢谢。

不会游泳的鱼

ZZXXQQ 发表于 2009-8-23 09:58
这是以前写的。
[/post]

版主你好，这个程序现在用来还是很好用，不知道能不能增加框选或是点选圆的功能呢？