[LISP程序]：快速改变圆直径的LISP源码

zzzcpu

本程序先选择同直径圆的一个样例，然后选择区域，
则该区域的所有同直径圆被亮选，最后输入要求的直径即可

2. 
   
3. (defun c:chc (/ sel exap typ1 dia1 cn1 chd gop rad1 num1)
   
4.   (setq sel (CAR (ENTSEL "\nSelect the example circle: ")))
   
5.   (print sel)
   
6.   (SETQ exap (ENTGET sel))
   
7.   (setq typ1 (cdr (assoc '0 exap)))
   
8. 
   
9.   (if (= typ1 "CIRCLE")
   
10.     (progn
    
11.       (setq rad1 (cdr (assoc '40 exap)))
    
12.       (setq
    
13.         gop
    
14.          (SSGET        (list (cons 0 "Circle") (cons -4 "=") (cons 40 rad1))
    
15.          )
    
16.       )
    
17.       (SSSETFIRST NIL GOP)
    
18.       (princ "\nThe GOP number: ")
    
19.       (princ (sslength gop))
    
20.       (setq dia1 (/ (getreal "\nEnter the diameter: ") 2))
    
21.       (SETQ num1 (- (sslength gop) 1))
    
22.       (repeat (1+ num1)
    
23.         (setq cn1 (ssname gop num1))
    
24.         (SETQ chd (ENTGET cn1))
    
25.         (setq chd (subst (cons 40 dia1) (assoc '40 chd) chd))
    
26.         (entmod chd)
    
27.         (setq num1 (1- num1))
    
28.       )
    
29. 
    
30.     )
    
31.   )
    
32.   (princ)
    
33. )

<br /> (defun c:chc (/ sel exap typ1 dia1 cn1 chd gop rad1 num1)<br />   (setq sel (CAR (ENTSEL "\nSelect the example circle: ")))<br />   (print sel)<br />   (SETQ exap (ENTGET sel))<br />   (setq typ1 (cdr (assoc '0 exap)))<br /> <br />   (if (= typ1 "CIRCLE")<br />     (progn<br />       (setq rad1 (cdr (assoc '40 exap)))<br />       (setq<br />         gop<br />          (SSGET        (list (cons 0 "Circle") (cons -4 "=") (cons 40 rad1))<br />          )<br />       )<br />       (SSSETFIRST NIL GOP)<br />       (princ "\nThe GOP number: ")<br />       (princ (sslength gop))<br />       (setq dia1 (/ (getreal "\nEnter the diameter: ") 2))<br />       (SETQ num1 (- (sslength gop) 1))<br />       (repeat (1+ num1)<br />         (setq cn1 (ssname gop num1))<br />         (SETQ chd (ENTGET cn1))<br />         (setq chd (subst (cons 40 dia1) (assoc '40 chd) chd))<br />         (entmod chd)<br />         (setq num1 (1- num1))<br />       )<br /> <br />     )<br />   )<br />   (princ)<br /> )

haibinpro

这个不错，谢谢分享。

shoran2

大师 请向你致敬

ilovem

谢谢楼主无私分享

ilovem

加载出错，参数类型不对