[LISP程序]：可将圆、弧、线、聚合线加上宽度

lulusteven

2. (defun c:cirw()
   
3.    (setvar "cmdecho" 0)
   
4.    (setq ww (getdist "\n宽度 <1>: "))
   
5.    (if (= ww nil) (setq ww 1.0))
   
6.    (setq ss (ssget))
   
7.    (setq s 0)
   
8.    (repeat (sslength ss)
   
9.       (setq ssn (ssname ss s))
   
10.       (setq entyp (cdr (assoc 0 (entget ssn))))
    
11.       (cond ((= entyp "CIRCLE") (progn
    
12.           (setq rr (cdr (assoc 40 (entget ssn))))
    
13.           (setq cen (cdr (assoc 10 (entget ssn))))
    
14.           (command "donut" (* 2 (- rr (/ ww 2))) (* 2 (+ rr (/ ww 2))) cen "")
    
15.           (command "erase" ssn "")
    
16.           ))
    
17.           ((= entyp "LINE") (command "pedit" ssn "y" "w" ww ""))
    
18.           ((= entyp "ARC") (command "pedit" ssn "y" "w" ww ""))
    
19.           ((= entyp "LWPOLYLINE") (command "pedit" ssn "w" ww ""))
    
20.           ((= entyp "POLYLINE") (command "pedit" ssn "w" ww ""))
    
21.       )
    
22.       (setq s (1+ s))
    
23.     )
    
24. )

(defun c:cirw()<br />    (setvar "cmdecho" 0)<br />    (setq ww (getdist "\n宽度 <1>: "))<br />    (if (= ww nil) (setq ww 1.0))<br />    (setq ss (ssget))<br />    (setq s 0)<br />    (repeat (sslength ss)<br />       (setq ssn (ssname ss s))<br />       (setq entyp (cdr (assoc 0 (entget ssn))))<br />       (cond ((= entyp "CIRCLE") (progn<br />           (setq rr (cdr (assoc 40 (entget ssn))))<br />           (setq cen (cdr (assoc 10 (entget ssn))))<br />           (command "donut" (* 2 (- rr (/ ww 2))) (* 2 (+ rr (/ ww 2))) cen "")<br />           (command "erase" ssn "")<br />           ))<br />           ((= entyp "LINE") (command "pedit" ssn "y" "w" ww ""))<br />           ((= entyp "ARC") (command "pedit" ssn "y" "w" ww ""))<br />           ((= entyp "LWPOLYLINE") (command "pedit" ssn "w" ww ""))<br />           ((= entyp "POLYLINE") (command "pedit" ssn "w" ww ""))<br />       )<br />       (setq s (1+ s))<br />     )<br /> )