有若干个圆和若干条直线，圆和一条或多条直线相交，要求程序能自动将所有圆内的直线剪

yybu

有哪位大侠能编一个满足如下要求的纯LISP程序，要求如下：

有若干个圆和若干条直线，圆和一条或多条直线相交，要求程序能自动将所有圆内的直线剪切掉。

zxq0220

2. 
   
3. (defun C:TRIMC (/ e p pc k r n ep)
   
4. (SETVAR "CMDECHO" 0)
   
5. (SETQ OLDOS (GETVAR "OSMODE") OLDBLIP (GETVAR "BLIPMODE"))
   
6. (SETVAR "BLIPMODE" 0)
   
7. (SETVAR "OSMODE" 0)
   
8. (princ "\nPlease select a circle 请选择一个圆 :" )
   
9. (setq e (car (entsel))
   
10.       pc (cdr (assoc 10 (entget e)))
    
11.       r (cdr (assoc 40 (entget e)))
    
12. )
    
13. (setq n 0)
    
14. (setvar "pickbox" 5)
    
15. (command "trim" e "")
    
16. (repeat 180
    
17.    (command "f" (polar p (/(* 2 n pi) 180)(* r 0.99)))
    
18.    (setq n (1+ n))
    
19.    (command (polar p (/ (* 2 n pi) 180)(* r 0.99))"")
    
20. )
    
21. (command "redraw")
    
22. (SETVAR "BLIPMODE" 1)
    
23. (SETVAR "OSMODE" OLDOS)
    
24. (SETVAR "BLIPMODE" OLDBLIP)
    
25. (SETVAR "CMDECHO" 1)
    
26. (princ)
    
27. )
    
28. 
    
29. (princ "\nType TRIMC to start.")
    
30. (princ)
    

<br /> (defun C:TRIMC (/ e p pc k r n ep)<br /> (SETVAR "CMDECHO" 0)<br /> (SETQ OLDOS (GETVAR "OSMODE") OLDBLIP (GETVAR "BLIPMODE"))<br /> (SETVAR "BLIPMODE" 0)<br /> (SETVAR "OSMODE" 0)<br /> (princ "\nPlease select a circle 请选择一个圆 :" )<br /> (setq e (car (entsel))<br />       pc (cdr (assoc 10 (entget e)))<br />       r (cdr (assoc 40 (entget e)))<br /> )<br /> (setq n 0)<br /> (setvar "pickbox" 5)<br /> (command "trim" e "")<br /> (repeat 180<br />    (command "f" (polar p (/(* 2 n pi) 180)(* r 0.99)))<br />    (setq n (1+ n))<br />    (command (polar p (/ (* 2 n pi) 180)(* r 0.99))"")<br /> )<br /> (command "redraw")<br /> (SETVAR "BLIPMODE" 1)<br /> (SETVAR "OSMODE" OLDOS)<br /> (SETVAR "BLIPMODE" OLDBLIP)<br /> (SETVAR "CMDECHO" 1)<br /> (princ)<br /> )<br /> <br /> (princ "\nType TRIMC to start.")<br /> (princ)<br />

yybu

楼上的程序用不了！！！

ljpnb

这两句修改一下就可以用了，2楼的程序不错，比较狠！！！！！！
(command "f" (polar pc (/(* 2 n pi) 180)(* r 0.99)))   ;_这里应该是pc，不是p
   (setq n (1+ n))
   (command (polar pc (/ (* 2 n pi) 180)(* r 0.99))"")   ;_这里应该是pc，不是p

whiteon

好程序，就叫它“一刀切”吧

f5612140

1.
(repeat 180
   (command "f" (polar pc (/(* 2 n pi) 180)(* r 0.99)))
   (setq n (1+ n))
   (command (polar pc (/ (* 2 n pi) 180)(* r 0.99)) "")
)
(command "") ;多這行正常些

2.entsel --> (while (entsel --> ssget否則不比trim高明多少
3.2樓朋友應該有一個ssget的

xyp1964

测试：支持框选，内、外可选择。不支持多义线*PLINE
[php]
;;;加载通用函数
;;;下载：http://www.xdcad.net/forum/showthread.php?s=&threadid=325268
(load "xyp_lib")

;;;以圆为边界剪切内或外实体
;;;不支持多义线*PLINE
(defun c:test085 ()
  (cmdla0)
  (setq tx1 (ukword 1 "1 2" "\n\选择方向 : 1-内部/2-外部" tx1))
  (setq        SS (ssget '((0 . "CIRCLE")))
        n  -1
  )
  (setvar "osmode" 0)
  (command ".undo" "BE")
  (while (setq s1 (ssname ss (setq n (1+ n))))
    (setq rad (dxf 40 (entget s1))
          pt  (dxf 10 (entget s1))
          m   0
    )
  (repeat 5
    (tr-f)
     )
   )
  (command ".undo" "E")
  (cmdla0)
)
(defun tr-f ()
  (command "trim" ss "" "F")
  (repeat 361
    (if        (= tx1 "1")
      (setq pt1 (polar pt (* m (/ pi 180)) (- rad (/ rad 100))))
      (setq pt1 (polar pt (* m (/ pi 180)) (+ rad (/ rad 100))))
    )
    (setq m (1+ m))
    (command pt1)
  )
  (command "" "")
)
[/php]

狂刀

多义线多次与圆交叉的情况。。。。不行

zxq0220

谢谢各位的指正，下面发一个SSGET版的。

2. 
   
3. (defun C:TRIMC (/ e SS SL I pc r n)
   
4. (SETVAR "CMDECHO" 0)
   
5. (SETQ OLDOS (GETVAR "OSMODE") OLDBLIP (GETVAR "BLIPMODE"))
   
6. (SETVAR "BLIPMODE" 0)
   
7. (SETVAR "OSMODE" 0)
   
8. (princ "\nPlease select a circle 请选择圆 :" )
   
9. (IF (SETQ SS (SSGET '((0 . "CIRCLE")))) (PROGN
   
10. (SETQ SL (SSLENGTH SS) I 0)
    
11. (REPEAT SL
    
12.   (setq e (SSNAME SS I)
    
13.         pc (cdr (assoc 10 (entget e)))
    
14.         r (* (cdr (assoc 40 (entget e))) 0.99)
    
15.         I (1+ I)
    
16.   )
    
17.   (setq n 0)
    
18.   (setvar "pickbox" 5)
    
19.   (command "trim" e "")
    
20.   (repeat 180
    
21.    (command "f" (polar pc (/ (* 2 n pi) 180) r))
    
22.    (setq n (1+ n))
    
23.    (command (polar pc (/ (* 2 n pi) 180) r) "")
    
24.   )
    
25.   (command "")
    
26. )
    
27. ))
    
28. (SETVAR "OSMODE" OLDOS)
    
29. (SETVAR "BLIPMODE" OLDBLIP)
    
30. (SETVAR "CMDECHO" 1)
    
31. (princ)
    
32. )
    
33. 
    
34. (princ "\nType TRIMC to start.")
    
35. (princ)
    

<br /> (defun C:TRIMC (/ e SS SL I pc r n)<br /> (SETVAR "CMDECHO" 0)<br /> (SETQ OLDOS (GETVAR "OSMODE") OLDBLIP (GETVAR "BLIPMODE"))<br /> (SETVAR "BLIPMODE" 0)<br /> (SETVAR "OSMODE" 0)<br /> (princ "\nPlease select a circle 请选择圆 :" )<br /> (IF (SETQ SS (SSGET '((0 . "CIRCLE")))) (PROGN<br /> (SETQ SL (SSLENGTH SS) I 0)<br /> (REPEAT SL<br />   (setq e (SSNAME SS I)<br />         pc (cdr (assoc 10 (entget e)))<br />         r (* (cdr (assoc 40 (entget e))) 0.99)<br />         I (1+ I)<br />   )<br />   (setq n 0)<br />   (setvar "pickbox" 5)<br />   (command "trim" e "")<br />   (repeat 180<br />    (command "f" (polar pc (/ (* 2 n pi) 180) r))<br />    (setq n (1+ n))<br />    (command (polar pc (/ (* 2 n pi) 180) r) "")<br />   )<br />   (command "")<br /> )<br /> ))<br /> (SETVAR "OSMODE" OLDOS)<br /> (SETVAR "BLIPMODE" OLDBLIP)<br /> (SETVAR "CMDECHO" 1)<br /> (princ)<br /> )<br /> <br /> (princ "\nType TRIMC to start.")<br /> (princ)<br />

silen618

为什么不试一试扩展工具里的EXTRIM，简单易行，完全可以实现，功能更强大。

f5612140

樓上兄弟,看看extrim要幾個步驟

zxq0220

最初由 silen618 发布
[B]为什么不试一试扩展工具里的EXTRIM，简单易行，完全可以实现，功能更强大。 [/B]

一楼楼主想要的是纯LISP的程序。

yybu

感谢xyp1964 和zxq0220  ！！你们的程序帮了大忙！！