[LISP程序]：多义线宽格式刷-之2

梦断江南

;plw(plw)线宽匹配,用undo——Back 恢复------lxx-----2001.1.[2001.4]
;对line,arc,circle,pline, 有效。
;请保留princ信息行。
;main

2. 
   
3. (DEFUN C:plw (/ t went wentn wid s i ent entn)   
   
4. (princ "线宽匹配------lxx-----2001.1.22")
   
5. (princ "\n请选择匹配源:")(setq t "true")
   
6. (command "undo" "m")
   
7. (while t
   
8.   (setq went (car (entsel)))
   
9.   (if went (setq wentn (cdr(assoc 0 (entget went)))) )
   
10.   (cond
    
11.    ((not went) (princ "\n未选中实体,请再选择:"))
    
12.    ((or (= wentn "POLYLINE")(= wentn "LWPOLYLINE"))
    
13.     (setq wid (cdr (assoc 40 (entget went)))) ;get width
    
14.     (setq t nil)
    
15.    )
    
16.    (t (setq wid 0)(setq t nil))
    
17.   )     
    
18. );while end
    
19. (princ "\n线宽=")(princ wid)
    
20. (princ "\n选择需要匹配的实体:")
    
21. (setq s (ssget '((0 . "POLYLINE,LWPOLYLINE,LINE,ARC,CIRCLE")) ) i 0)
    
22. (repeat (sslength s)
    
23.    (setq ent (ssname s i) entn (cdr (assoc 0 (entget ent))))
    
24.    (cond
    
25.      ((or(= entn "POLYLINE")(= entn "LWPOLYLINE"))(command "pedit" ent "w" wid ""))
    
26.      ((or (= entn "LINE") (= entn "ARC"))
    
27.       (command "pedit" ent "y" "w" wid ""))
    
28.      ((= entn "CIRCLE")
    
29.       (progn
    
30.        (setq cen (cdr (assoc 10 (entget ent)))
    
31.              rad (cdr (assoc 40 (entget ent)))
    
32.              d1 (- (* 2 rad) wid)
    
33.              d2 (+ (* 2 rad) wid)
    
34.         )
    
35.        (command "donut" d1 d2 cen "") ;;;erase circle ,create donut
    
36.        (entdel ent)
    
37.       ))
    
38.    )  ;;;cond
    
39.    (setq i (+ 1 i))
    
40. ) ;repeat
    
41. (princ "\n用undo——Back 恢复")(princ)
    
42. )
    
43. (princ "plw线宽匹配------lxx-----2001.1.22")(princ)
    

<br /> (DEFUN C:plw (/ t went wentn wid s i ent entn)   <br /> (princ "线宽匹配------lxx-----2001.1.22")<br /> (princ "\n请选择匹配源:")(setq t "true")<br /> (command "undo" "m")<br /> (while t <br />   (setq went (car (entsel)))<br />   (if went (setq wentn (cdr(assoc 0 (entget went)))) )<br />   (cond <br />    ((not went) (princ "\n未选中实体,请再选择:"))<br />    ((or (= wentn "POLYLINE")(= wentn "LWPOLYLINE"))<br />     (setq wid (cdr (assoc 40 (entget went)))) ;get width<br />     (setq t nil)<br />    )<br />    (t (setq wid 0)(setq t nil))<br />   )     <br /> );while end<br /> (princ "\n线宽=")(princ wid)<br /> (princ "\n选择需要匹配的实体:")<br /> (setq s (ssget '((0 . "POLYLINE,LWPOLYLINE,LINE,ARC,CIRCLE")) ) i 0)<br /> (repeat (sslength s)<br />    (setq ent (ssname s i) entn (cdr (assoc 0 (entget ent))))<br />    (cond <br />      ((or(= entn "POLYLINE")(= entn "LWPOLYLINE"))(command "pedit" ent "w" wid ""))<br />      ((or (= entn "LINE") (= entn "ARC"))<br />       (command "pedit" ent "y" "w" wid ""))<br />      ((= entn "CIRCLE")<br />       (progn<br />        (setq cen (cdr (assoc 10 (entget ent)))<br />              rad (cdr (assoc 40 (entget ent)))<br />              d1 (- (* 2 rad) wid)<br />              d2 (+ (* 2 rad) wid)<br />         )<br />        (command "donut" d1 d2 cen "") ;;;erase circle ,create donut<br />        (entdel ent)<br />       ))<br />    )  ;;;cond<br />    (setq i (+ 1 i))<br /> ) ;repeat<br /> (princ "\n用undo——Back 恢复")(princ)<br /> )<br /> (princ "plw线宽匹配------lxx-----2001.1.22")(princ)<br />

aeo

少了"circle"

梦断江南

？？？有啊