[编程申请]：自动剪裁N个相同物体中所有东西的程序

njyulei

比如有n个相同物体(圆或闭合多段线),能把所有内部的东西自动剪切掉,

eachy

相交的修剪内部的删除？

njyulei

对相交的修剪内部的删除,请eachy斑竹帮个忙有急用,

zxq0220

以前写的，供参考。斑竹还要求人呀。

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

<br /> ;圆内删除<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 /> <br /> (princ "\nType ERASEC to start.")<br /> (princ)<br />

狂刀

人家是版主，但是未必是程序开发板块的版主：）

njyulei

最初由 zxq0220 发布
[B]什么错？我在R14上调试通过，可以删除剪切所有圆内的元素。 [/B]

我找到你的错误处原因了，是要剪裁的线段端点刚好和圆的圆心重合后出的错，请你改正，还有您能否加上一个选择对象功能，你现在程序是把图中所有圆内东西删剪掉，要是能选择某一图层的圆删剪东西就完美了。

zxq0220

少了俩括弧。
[php]
(DEFUN C:ERASEC (/ SS SL SN PC R N EN LN)
(SETVAR "BLIPMODE" 0)
(SETVAR "CMDECHO" 0)
(SETQ OLDOS (GETVAR "OSMODE"))
(SETVAR "OSMODE" 0)
(IF (SETQ EN (CAR (ENTSEL "\nSelect a Object 选择一个目标 : "))) (PROGN
  (SETQ LN (CDR (ASSOC 8 (ENTGET EN))))
  (IF (SETQ SS (SSGET "X" (LIST (CONS 0 "CIRCLE") (CONS 8 LN)))) (PROGN
   (SETQ SL (SSLENGTH SS) I 0)
   (REPEAT SL
    (SETQ SN (SSNAME SS I) I (1+ I)
          PC (CDR (ASSOC 10 (ENTGET SN)))
          R  (CDR (ASSOC 40 (ENTGET SN)))
          N 0
    )
    (COMMAND "ZOOM" "C" PC (* 3 R))
    (COMMAND "TRIM" SN "" "F")
    (REPEAT 180
     (COMMAND (POLAR PC (/ (* 2 N PI) 180) (* R 0.9)))
     (setq N (1+ N))
    )
    (COMMAND "" "")
    (SETQ N 0)
    (COMMAND "ERASE" "WP")
    (REPEAT 180
     (COMMAND (POLAR PC (/ (* 2 N PI) 180) (* R 0.9)))
     (setq N (1+ N))
    )
    (COMMAND "" "" "ZOOM" "P")
   )
  ))
))
(SETVAR "OSMODE" OLDOS)
(SETVAR "BLIPMODE" 1)
(SETVAR "CMDECHO" 1)
(PRINC)
)
[/php]

gdzhou

我也支持一下，附件程序是可以单选 多选 ，也可以按层选，可以裁内也可以裁外。
但不支持圆做为边界来裁。。。

njyulei

12楼的程序很强，如果能支持圆就好了。

gdzhou

还有一点不足，，，忘了加入判断选中图元是否为闭合的区域，以及在XP系统中程序的配置文件不能够保存提示错误。现以改正

li809

ET工具的extrim应该能满足楼主的要求吧

vang8866

好 谢谢了。我刚在编写自动绘制梁线的程序  这个 剪切命令很有用

xgwl

12 楼的程序,启动命令是什么!

gdzhou

这是一个CAD的宏程序，加载后直接按ALT+F8运行就可以了

雨中漫步0423

运行后呢？怎么启用啊？我没用宏……