一个改变线宽的Lisp，请大侠帮帮忙改下

dforme

本人是新手，找到一个改变线宽的lisp程序，但是无法运行，请高手们帮忙修改一下，谢谢了

2. (defun xiugaixiankuan()
   
3. (setq ss (ssget))
   
4. (if(/= ss nil)
   
5. (progn
   
6. (setq aw (strcat "\n 修改后的线宽:("(rtos w)")"))
   
7. (setq aw (getstring aw))
   
8. )
   
9. )
   
10. (if (/= aw "")
    
11. (setq w (atof aw))
    
12. (setq j (sslength ss)
    
13. i 0)
    
14. )
    
15. (repeat j
    
16. (setq a (ssname ss i))
    
17. (setq aa (entget a))
    
18. (setq i (+ 1 i))
    
19. (setq aname (cdr(assoc 0 aa)))
    
20. (if (= aname "LWPOLYLINE")
    
21. (command "pedit" a "w" w "")
    
22. )
    
23. (if (and (/= w 0) (= aname "LINE"))
    
24. (command "pedit" a "y" "w" w "")
    
25. )
    
26. 
    
27. (if (= aname "ARC")
    
28. (command "pedit" a "y" "w" w "")
    
29. )
    
30. (if (= aname "CIRCLE")
    
31. (PROGN
    
32. (setq cen(cdr(assoc 10 aa)))
    
33. (setq r1(cdr(assoc 40 aa)))
    
34. (setq d (* 2 r1))
    
35. (setq d1 (- d w ))
    
36. (setq d2 (+ d w))
    
37. (command "donut" d1 d2 cen "")
    
38. )
    
39. )
    
40. )
    
41. )

(defun xiugaixiankuan() <br /> (setq ss (ssget)) <br /> (if(/= ss nil) <br /> (progn <br /> (setq aw (strcat "\n 修改后的线宽:("(rtos w)")")) <br /> (setq aw (getstring aw)) <br /> ) <br /> ) <br /> (if (/= aw "") <br /> (setq w (atof aw)) <br /> (setq j (sslength ss) <br /> i 0) <br /> ) <br /> (repeat j <br /> (setq a (ssname ss i)) <br /> (setq aa (entget a)) <br /> (setq i (+ 1 i)) <br /> (setq aname (cdr(assoc 0 aa))) <br /> (if (= aname "LWPOLYLINE") <br /> (command "pedit" a "w" w "") <br /> ) <br /> (if (and (/= w 0) (= aname "LINE")) <br /> (command "pedit" a "y" "w" w "") <br /> ) <br /> <br /> (if (= aname "ARC") <br /> (command "pedit" a "y" "w" w "") <br /> ) <br /> (if (= aname "CIRCLE") <br /> (PROGN <br /> (setq cen(cdr(assoc 10 aa))) <br /> (setq r1(cdr(assoc 40 aa))) <br /> (setq d (* 2 r1)) <br /> (setq d1 (- d w )) <br /> (setq d2 (+ d w)) <br /> (command "donut" d1 d2 cen "") <br /> ) <br /> ) <br /> ) <br /> )

dforme

有一个更简单的，但是只能对LWPOLYLINE进行操作，可不可以也改一下

1. (DEFUN C:PW(/ ENTGRP WIDTH COUNT ENT )
   
2.   (PRINC "\n编辑复线宽度:")
   
3.   (PRINC "\n注:需编辑部分必须串成复线")
   
4.   (SETVAR "CMDECHO" 0)
   
5.   (COMMAND "_.UNDO" "M")
   
6.   (PROMPT "\n请选择编辑部分:")
   
7.   (SETQ ENTGRP (SSGET '((0 . "LWPOLYLINE"))))
   
8.   (SETQ WIDTH (GETREAL "\n请输入宽度:"))
   
9.   (SETQ COUNT 0)
   
10.   (REPEAT (SSLENGTH ENTGRP)
    
11.     (SETQ ENT (SSNAME ENTGRP COUNT))
    
12.     (COMMAND "_.PEDIT" ENT "W" WIDTH "")
    
13.     (SETQ COUNT (1+ COUNT))
    
14.   )
    
15.   (PRINC "\n--------OK!!---------")
    
16.   (PRINC)
    
17. )

复制代码

ZZXXQQ

2. 
   
3. (defun gaixiankuan ()
   
4. (setq ss (ssget '((0 . "ARC,CIRCLE,LINE,*POLYLINE"))))
   
5. (setq w (if (numberp w) w 0.5))
   
6. (setq aw (getdist (strcat "\n 修改后的线宽:(" (rtos w) ")")))
   
7. (setq aw (if aw aw w))
   
8. (setq w aw)
   
9. (if(/= ss nil) (progn
   
10.   (setq j (sslength ss)
    
11.         i 0)
    
12.   (repeat j
    
13.    (setq a (ssname ss i))
    
14.    (setq aa (entget a))
    
15.    (setq i (+ 1 i))
    
16.    (setq aname (cdr(assoc 0 aa)))
    
17.    (cond
    
18.     ((wcmatch aname "*POLYLINE") (command "pedit" a "w" w ""))
    
19.     ((and (/= w 0) (= aname "LINE")) (command "pedit" a "y" "w" w ""))
    
20.     ((= aname "ARC") (command "pedit" a "y" "w" w ""))
    
21.     ((and (/= w 0) (= aname "CIRCLE"))
    
22.      (setq cen(cdr(assoc 10 aa)))
    
23.      (setq r1(cdr(assoc 40 aa)))
    
24.      (setq d (* 2 r1))
    
25.      (setq d1 (- d w))
    
26.      (setq d2 (+ d w))
    
27.      (command "donut" d1 d2 cen "")
    
28.     )
    
29.    )
    
30.   )
    
31. ))
    
32. (princ)
    
33. )
    

<br /> (defun gaixiankuan () <br /> (setq ss (ssget '((0 . "ARC,CIRCLE,LINE,*POLYLINE"))))<br /> (setq w (if (numberp w) w 0.5))<br /> (setq aw (getdist (strcat "\n 修改后的线宽:(" (rtos w) ")")))<br /> (setq aw (if aw aw w))<br /> (setq w aw) <br /> (if(/= ss nil) (progn <br />   (setq j (sslength ss) <br />         i 0) <br />   (repeat j <br />    (setq a (ssname ss i)) <br />    (setq aa (entget a)) <br />    (setq i (+ 1 i)) <br />    (setq aname (cdr(assoc 0 aa))) <br />    (cond<br />     ((wcmatch aname "*POLYLINE") (command "pedit" a "w" w "")) <br />     ((and (/= w 0) (= aname "LINE")) (command "pedit" a "y" "w" w "")) <br />     ((= aname "ARC") (command "pedit" a "y" "w" w "")) <br />     ((and (/= w 0) (= aname "CIRCLE"))<br />      (setq cen(cdr(assoc 10 aa))) <br />      (setq r1(cdr(assoc 40 aa))) <br />      (setq d (* 2 r1)) <br />      (setq d1 (- d w)) <br />      (setq d2 (+ d w)) <br />      (command "donut" d1 d2 cen "") <br />     ) <br />    ) <br />   )<br /> )) <br /> (princ)<br /> )<br />

wudechao

(defun c:gp (/ *error* s2 n e ty wd index pt rad r1 r2 old_lay date1 ffg oos)
(setvar "cmdecho" 0)
(defun *error* (msg)
  (if oos
   (setvar "osmode" oos)
  )
  (if old_lay
   (setvar "clayer" old_lay)
  )
)
(setq oos (getvar "osmode"))
(setvar "osmode" 0)
(setq old_lay (getvar "clayer"))
(prompt "\n请选择要连接成多义线的线(line,arc,circle,lwpolyline)<退出>:")
(setq s2 (ssget '((-4 . "<AND") (0 . "LINE,LWPOLYLINE,ARC,CIRCLE")
    (-4 . "AND>")
   )
   )
)
(if (/= s2 nil)
  (progn
   (setq date1 (getvar "CDATE"))
   (setq wd (getdist "多义线宽度<0>:")
  wd (if wd
      wd
      0
     )
   )
   (setq n (sslength s2))
   (setq index 0)
   (repeat n
    (setq e (ssname s2 index)
   ent (entget e)
   index (+ 1 index)
   ty (assoc 0 ent)
    )
    (if (= "LWPOLYLINE" (cdr ty))
     (progn
      (command ".change" s2 "" "P" "C" "bylayer" "")
      (setq ffg (cdr (assoc 70 ent)))
      (if (= ffg 0)
       (command ".pedit" e "j" s2 "" "w" wd "")
       (command ".pedit" e "w" wd "")
      )
     )
    )
    (if (= "LINE" (cdr ty))
     (progn
      (command ".change" s2 "" "P" "C" "bylayer" "")
      (command ".pedit" e "y" "j" s2 "" "w" wd "")
     )
    )
    (if (= "CIRCLE" (cdr ty))
     (progn
      (setq pt (cdr (assoc 10 ent)))
      (setq rad (cdr (assoc 40 ent)))
      (setq r1 (- (* rad 2) wd))
      (setq r2 (+ (* rad 2) wd))
      (if (> wd (* 2 rad))
       (progn
(setq r1 0)
(setq r2 (* rad 2))
       )
      )
      (command ".change" s2 "" "P" "C" "bylayer" "")
      (command "_donut" r1 r2 pt "")
      (entdel e)
     )
    )
    (if (= "ARC" (cdr ty))
     (progn
      (setq r1 (cdr (assoc 10 ent)))
      (setq r2 (cdr (assoc 40 ent)))
      (setq pt (cdr (assoc 50 ent)))
      (setq rad (cdr (assoc 51 ent)))
      (setq p1 (polar r1 pt r2))
      (setq p2 (polar r1 rad r2))
      (command ".change" s2 "" "P" "C" "bylayer" "")
      (command "_pline" p1 "_w" wd wd "_a" "_ce" r1 p2 "")
      (entdel e)
     )
    )
   )
   (setq n (itoa n)
  wd (rtos wd 2 0)
   )
   (prompt (strcat "\n共有\"" n "\"条线宽度变为\"" wd "\"的多义线。耗时\"" (rtos (* (- (getvar "CDATE") date1) 86400) 2 3)
     "\"秒。"
    )
   )
  )
)
(command "_clayer" old_lay)
(setvar "osmode" oos)
(setvar "cmdecho" 1)
(princ)
)

dforme

感谢ZZXXQQ版主，把我的2个要求都中和进去了
wudechao的办法也可以，只是把线的颜色改变了，还要刷一次颜色

lohas1118

ZZXXQQ 发表于 2012-10-10 19:06

加载后
命令: gaixiankuan 未知命令“GAIXIANKUAN”。按 F1 查看帮助。