[编程申请]：求圆内剪切的lisp程序？

李军

有没有一个圆内剪切的lisp程序？作图时，图内圆大多，而且有很多线穿在圆内，可否编辑一个lisp程序，当用图元过滤选择所有圆作为边界时，所有圆内的线条均被切断？谢谢！！

zxq0220

楼主试一下能否工作。程序在R14上调试通过。

2. 
   
3. (DEFUN C:ERASEC (/ SS SL SN PC R N)
   
4. (SETVAR "BLIPMODE" 0)
   
5. (SETVAR "CMDECHO" 0)
   
6. (IF (SETQ SS (SSGET "X" '((0 . "CIRCLE")))) (PROGN
   
7.   (SETQ SL (SSLENGTH SS) I 0)
   
8.   (REPEAT SL
   
9.    (SETQ SN (SSNAME SS I) I (1+ I)
   
10.          PC (CDR (ASSOC 10 (ENTGET SN)))
    
11.          R  (CDR (ASSOC 40 (ENTGET SN)))
    
12.          N 0
    
13.    )
    
14.    (COMMAND "ZOOM" "C" PC (* 3 R))
    
15.    (COMMAND "TRIM" SN "" "F")
    
16.    (REPEAT 180
    
17.     (COMMAND (POLAR PC (/ (* 2 N PI) 180) (* R 0.9)))
    
18.     (setq N (1+ N))
    
19.    )
    
20.    (COMMAND "" "")
    
21.    (SETQ N 0)
    
22.    (COMMAND "ERASE" "WP")
    
23.    (REPEAT 180
    
24.     (COMMAND (POLAR PC (/ (* 2 N PI) 180) (* R 0.9)))
    
25.     (setq N (1+ N))
    
26.    )
    
27.    (COMMAND "" "" "ZOOM" "P")
    
28.   )
    
29. ))
    
30. (SETVAR "BLIPMODE" 1)
    
31. (SETVAR "CMDECHO" 1)
    
32. (PRINC)
    
33. )
    

<br /> (DEFUN C:ERASEC (/ SS SL SN PC R N)<br /> (SETVAR "BLIPMODE" 0)<br /> (SETVAR "CMDECHO" 0)<br /> (IF (SETQ SS (SSGET "X" '((0 . "CIRCLE")))) (PROGN<br />   (SETQ SL (SSLENGTH SS) I 0)<br />   (REPEAT SL<br />    (SETQ SN (SSNAME SS I) I (1+ I)<br />          PC (CDR (ASSOC 10 (ENTGET SN)))<br />          R  (CDR (ASSOC 40 (ENTGET SN)))<br />          N 0<br />    )<br />    (COMMAND "ZOOM" "C" PC (* 3 R))<br />    (COMMAND "TRIM" SN "" "F")<br />    (REPEAT 180<br />     (COMMAND (POLAR PC (/ (* 2 N PI) 180) (* R 0.9)))<br />     (setq N (1+ N))<br />    )<br />    (COMMAND "" "")<br />    (SETQ N 0)<br />    (COMMAND "ERASE" "WP")<br />    (REPEAT 180<br />     (COMMAND (POLAR PC (/ (* 2 N PI) 180) (* R 0.9)))<br />     (setq N (1+ N))<br />    )<br />    (COMMAND "" "" "ZOOM" "P")<br />   )<br /> ))<br /> (SETVAR "BLIPMODE" 1)<br /> (SETVAR "CMDECHO" 1)<br /> (PRINC)<br /> )<br />

李军

to;zxq0220：谢谢！程序在R14中出错，请问何故？
执行过程：
Command: appload

Loading D:\Tangent\work\ERASEC.lsp ...

Command: erasec


Invalid point, polygon segment is zero length.

Invalid response.

Invalid response.

Invalid response.
((ST) (IF (AND (/= ST "Function cancelled") (/= ST "quit / exit abort")) (PRINC
(STRCAT "\n错误: " ST "\n"))) (XDRX_SYSVAR_POP) (XDRX_DRAWING_VIEWRES)
(XDRX_PBAREND) (XDRX_END) (SETQ *ERROR* $XDLSP_ERROR))
Undo/<Endpoint of line>:
Undo/<Endpoint of line>:

Object does not intersect an edge.
<Select object to trim>/Project/Edge/Undo:
Object does not intersect an edge.
<Select object to trim>/Project/Edge/Undo:

zxq0220

我在R14上调试通过，无任何错误。看了您的错误提示，好象是程序与晓东工具箱的设定有冲突。看一下您拷贝的程序是否多了右括弧？

李军

to:zxq0220：我是从网页copy的，不知错在何处？请看我的附件？

zxq0220

不知道是怎么回事。下载后，在我的机器上的R14中可以运行，无任何错误。

小小的人

zxq0220 发表于 2004-12-7 14:17
楼主试一下能否工作。程序在R14上调试通过。

你好   这个可以改为只剪切选择的那部分圆吗   直接全部都剪切的话 圆很多的话会死机   还有不需要剪切的会被剪切掉

newer

小小的人 发表于 2020-4-12 21:04
你好   这个可以改为只剪切选择的那部分圆吗   直接全部都剪切的话 圆很多的话会死机   还有不需要剪切的 ...

把
(SSGET "X" '((0 . "CIRCLE"))))

"X"去掉

变成

(SSGET  '((0 . "CIRCLE"))))

小小的人

newer 发表于 2020-4-12 21:12
把
(SSGET "X" '((0 . "CIRCLE"))))

完美解决  非常感谢你

小小的人

newer 发表于 2020-4-12 21:12
把
(SSGET "X" '((0 . "CIRCLE"))))

能不能加上批量圆内选择功能   就是批量选择一部分圆  就能选中圆内的所有实体

小小的人

newer 发表于 2020-4-12 21:12
把
(SSGET "X" '((0 . "CIRCLE"))))

运行程序之后  不管鼠标点哪里  都会出现小白点   点多少出现多少  滑轮滚动后会消失   

Lisphk

小小的人 发表于 2020-4-12 22:33
运行程序之后  不管鼠标点哪里  都会出现小白点   点多少出现多少  滑轮滚动后会消失

程序开始处加上
(setvar "blipmode" 0)

小小的人

newer 发表于 2020-4-12 21:12
把
(SSGET "X" '((0 . "CIRCLE"))))

这样的小白点   不滚动鼠标滑轮 不会消失

小小的人

Lisphk 发表于 2020-4-12 22:42
程序开始处加上
(setvar "blipmode" 0)

我看程序开始出已经有了   再加一次？

小小的人

newer 发表于 2020-4-12 21:12
把
(SSGET "X" '((0 . "CIRCLE"))))

这是怎么回事  重启CAD就这样了