[LISP函数]：紧急求救xyp1964大哥！！！能否帮我把这个程序修改一下

qqdswan

前几天，你给我的那个程序在R14下不能运行，我试着修改了一下，源代码如下：
(defun c:xkhd ()
  (setq        ss (ssget '((0 . "CIRCLE,ELLIPSE,*LINE,ARC")))
        i  -1
  )
  (while (setq s1 (ssname ss (setq i (1+ i))))
    (if        (setq lw (* (cdr (assoc 39 (entget s1))) 0.01)) ;39厚度
      (command "pedit" "y" "" "w" lw "")
    )
  )
  (princ)
)
(princ "\n命令 : xkhd (线宽厚度)")
(princ)
但加载后不能运行，系统也不报错。
因为我基本上没有进行过cad的编程，没有经验，请大哥帮我解决一下。
我的最终目的是要让R14显示的和2002下显示的一样。
刚开始时，我以为只要有厚度就可以显示了，但事实上并不是这样。现在只有在2002下将线宽值付给厚度值，转换时将随之进入R14然后再将厚度值付给R14，使线宽实现出来。
请问大哥，能不能把这个程序修改一下，使得实现这个功能。
我现在等着急用。
急盼回复！！！
泣血跪求！！！
求求大哥了！！！

xyp1964

2. [FONT=courier new](defun c:xkhd ()
   
3.   (setq        ss (ssget '((0 . "*LINE")))
   
4.         i  -1
   
5.   )
   
6.   (while (setq s1 (ssname ss (setq i (1+ i))))
   
7.     (if        (setq lw (* (cdr (assoc 39 (entget s1))) 0.01)) ;39厚度
   
8.       (progn
   
9.         (if (= (cdr (assoc 0 (entget s1))) "LINE")
   
10.           (command "pedit" s1 "y" "w" lw "")
    
11.           (command "pedit" s1 "w" lw "")
    
12.         )
    
13.       )
    
14.     )
    
15.   )
    
16.   (princ)
    
17. )
    
18. (princ "\n命令 : xkhd (线宽厚度)")
    
19. (princ)[/FONT]

[FONT=courier new](defun c:xkhd ()<br />   (setq        ss (ssget '((0 . "*LINE")))<br />         i  -1<br />   )<br />   (while (setq s1 (ssname ss (setq i (1+ i))))<br />     (if        (setq lw (* (cdr (assoc 39 (entget s1))) 0.01)) ;39厚度<br />       (progn<br />         (if (= (cdr (assoc 0 (entget s1))) "LINE")<br />           (command "pedit" s1 "y" "w" lw "")<br />           (command "pedit" s1 "w" lw "")<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br /> (princ "\n命令 : xkhd (线宽厚度)")<br /> (princ)[/FONT]

qqdswan

谢谢xyp1964大哥了。

zxq0220

最初由 xyp1964 发布
[B][CODE](defun c:xkhd ()
  (setq        ss (ssget '((0 . "*LINE")))
        i  -1
  )
  (while (setq s1 (ssname ss (setq i (1+ i))))
    (if        (setq lw (* (cdr (assoc 39 (entget s1))) 0.01)) ;39?.. [/B]

SPLINE线可以设线宽吗？
如果不能，是否将(SSGET '((0 . "*LINE")))改成(SSGET '((0 . "*POLYLINE")))。

qqdswan

谢谢各位高手们的关注，
不过我在运行时，程序并不能自动选择图元，只能在运行xkhd后，我手工全选整个图，然后才能运行，
还有，程序这能修改*line项，其他的不能，我试着做了如下修改，但老是提示程序错。
源代码如下：
；；
(defun c:xkhd ()
  (setq        ss (ssget '((0 . "CIRCLE,ELLIPSE,*LINE,ARC")))
        i  -1
  )
  (while (setq s1 (ssname ss (setq i (1+ i))))
    (if        (setq lw (* (cdr (assoc 39 (entget s1))) 0.01)) ;39厚度
      (progn
        (if (= (cdr (assoc 0 (entget s1))) "*LINE")
         (if (= (cdr (assoc 0 (entget s1))) "LINE")
           (command "pedit" s1 "y" "w" lw "")
           (command "pedit" s1 "w" lw "")
          )
          (if (= (cdr (assoc 0 (entget s1))) "CIRCLE")
          (command "pedit" s1 "y" "w" lw "")
          (if (= (cdr (assoc 0 (entget s1))) "ELLIPSE")
          (command "pedit" s1 "y" "w" lw "")
          (if (= (cdr (assoc 0 (entget s1))) "ARC")
          (command "pedit" s1 "y" "w" lw "")
        )
        )
        )
        )
      )
    )
  )
  (princ)
)
(princ "\n命令 : xkhd (线宽厚度)")
(princ)
能不能帮我看一下，
让程序把所有的（除去字体，当然如果能修改的话更好）元素都修改掉。
急盼回复！！！
谢谢各位前辈！！！
谢谢大哥！！！
急盼回复！！！

zxq0220

2. 
   
3. (DEFUN C:XKHD ()
   
4. (SETVAR "CMDECHO" 0)
   
5. (SETQ SS (SSGET "X" '((0 . "CIRCLE,*POLYLINE,ARC"))) i -1)
   
6. (WHILE (SETQ S1 (SSNAME SS (SETQ I (1+ I))))
   
7.   (SETQ ENT (ENTGET S1) ENAME (CDR (ASSOC 0 ENT)))
   
8.   (IF (SETQ LW (* (CDR (ASSOC 39 ENT)) 0.01)) ;39厚度
   
9.    (IF (WCMATCH ENAME "*POLYLINE")
   
10.     (COMMAND "CHPROP" S1 "" "T" "0" "" "PEDIT" S1 "W" LW "")
    
11.     (IF (= ENAME "CIRCLE") (PROGN
    
12.      (SETQ PC (CDR (ASSOC 10 ENT))
    
13.            R (- (* (CDR (ASSOC 40 ENT))) 2) (* LW 0.5))
    
14.            R0 (+ R LW))
    
15.      (ENTDEL S1)
    
16.      (COMMAND "DONUT" R R0 PC "")
    
17.     )
    
18.      (COMMAND "CHPROP" S1 "" "T" "0" "" "PEDIT" S1 "Y" "W" LW "")
    
19.     )
    
20.    )
    
21.   )
    
22. )
    
23. (SETVAR "CMDECHO" 1)
    
24. (PRINC)
    
25. )
    
26. (PRINC "\n命令 : xkhd (线宽厚度)")
    
27. (PRINC)
    

<br /> (DEFUN C:XKHD ()<br /> (SETVAR "CMDECHO" 0)<br /> (SETQ SS (SSGET "X" '((0 . "CIRCLE,*POLYLINE,ARC"))) i -1)<br /> (WHILE (SETQ S1 (SSNAME SS (SETQ I (1+ I))))<br />   (SETQ ENT (ENTGET S1) ENAME (CDR (ASSOC 0 ENT)))<br />   (IF (SETQ LW (* (CDR (ASSOC 39 ENT)) 0.01)) ;39厚度<br />    (IF (WCMATCH ENAME "*POLYLINE")<br />     (COMMAND "CHPROP" S1 "" "T" "0" "" "PEDIT" S1 "W" LW "")<br />     (IF (= ENAME "CIRCLE") (PROGN<br />      (SETQ PC (CDR (ASSOC 10 ENT))<br />            R (- (* (CDR (ASSOC 40 ENT))) 2) (* LW 0.5))<br />            R0 (+ R LW))<br />      (ENTDEL S1)<br />      (COMMAND "DONUT" R R0 PC "")<br />     )<br />      (COMMAND "CHPROP" S1 "" "T" "0" "" "PEDIT" S1 "Y" "W" LW "")<br />     )<br />    )<br />   )<br /> )<br /> (SETVAR "CMDECHO" 1)<br /> (PRINC)<br /> )<br /> (PRINC "\n命令 : xkhd (线宽厚度)")<br /> (PRINC)<br />