[求助]：PKPM钢筋符号转化为%%130、%%131Lisp程序

civil_liyan

小弟在论坛上看到了这样一则贴子，现在找不到了，可以我没有爱心币。
现在提供几个好站：
http://www.qiufeng.net   好多下载
http://www.366.com      下载多多
能否烦请哪位大侠给小弟发一份 PKPM钢筋符号转化为 %%130、%%131的Lisp程序，万分感谢
civil_liyan@sina.com

zhynt

ｏｋ了：

2. 
   
3. (defun c:pkpmtoa ( / gs n m oldg oldgj gjt gjta gjja gjjb )
   
4.   (setq gs (ssget '((0 . "TEXT"))))
   
5.   (setq n 0)
   
6.   (setq m (sslength gs))
   
7.   (while (/= n m)
   
8.     (setq oldg (entget (ssname gs n)))
   
9.     (setq gjt (dxf 1 oldg))
   
10.     (setq gjje (cons 1 gjt))
    
11.     (if        (or (= (setq gjjb (substr gjt 1 1)) "\202")
    
12.             (= (setq gjjb (substr gjt 1 1)) "\203")
    
13.         )
    
14.       (progn
    
15.         (if (= gjjb "\202")
    
16.           (progn
    
17.             (setq gjja (substr gjt 2))
    
18.             (setq gjta (strcat "%%130" gjja))
    
19.           )
    
20.           (progn
    
21.             (setq gjja (substr gjt 2))
    
22.             (setq gjta (strcat "%%131" gjja))
    
23.           )
    
24.         )
    
25.         (setq oldg (subst (cons 1 gjta) gjje oldg))
    
26.         (entmod oldg)
    
27.       )
    
28.     )
    
29.     (if        (or (= (setq gjjb (substr gjt 2 1)) "\202")
    
30.             (= (setq gjjb (substr gjt 2 1)) "\203")
    
31.         )
    
32.       (progn
    
33.         (if (= gjjb "\202")
    
34.           (progn
    
35.             (setq gjjc (substr gjt 1 1))
    
36.             (setq gjja (substr gjt 3))
    
37.             (setq gjta (strcat gjjc "%%130" gjja))
    
38.           )
    
39.           (progn
    
40.             (setq gjjc (substr gjt 1 1))
    
41.             (setq gjja (substr gjt 3))
    
42.             (setq gjta (strcat gjjc "%%131" gjja))
    
43.           )
    
44.         )
    
45.         (setq oldg (subst (cons 1 gjta) gjje oldg))
    
46.         (entmod oldg)
    
47.       )
    
48.     )
    
49.     (if        (or (= (setq gjjb (substr gjt 3 1)) "\202")
    
50.             (= (setq gjjb (substr gjt 3 1)) "\203")
    
51.         )
    
52.       (progn
    
53.         (if (= gjjb "\202")
    
54.           (progn
    
55.             (setq gjjc (substr gjt 1 2))
    
56.             (setq gjja (substr gjt 4))
    
57.             (setq gjta (strcat gjjc "%%130" gjja))
    
58.           )
    
59.           (progn
    
60.             (setq gjjc (substr gjt 1 2))
    
61.             (setq gjja (substr gjt 4))
    
62.             (setq gjta (strcat gjjc "%%131" gjja))
    
63.           )
    
64.         )
    
65.         (setq oldg (subst (cons 1 gjta) gjje oldg))
    
66.         (entmod oldg)
    
67.       )
    
68.     )
    
69.     (setq n (1+ n))
    
70.   )
    
71. )
    

<br /> (defun c:pkpmtoa ( / gs n m oldg oldgj gjt gjta gjja gjjb )<br />   (setq gs (ssget '((0 . "TEXT"))))<br />   (setq n 0)<br />   (setq m (sslength gs))<br />   (while (/= n m)<br />     (setq oldg (entget (ssname gs n)))<br />     (setq gjt (dxf 1 oldg))<br />     (setq gjje (cons 1 gjt))<br />     (if        (or (= (setq gjjb (substr gjt 1 1)) "\202")<br />             (= (setq gjjb (substr gjt 1 1)) "\203")<br />         )<br />       (progn<br />         (if (= gjjb "\202")<br />           (progn<br />             (setq gjja (substr gjt 2))<br />             (setq gjta (strcat "%%130" gjja))<br />           )<br />           (progn<br />             (setq gjja (substr gjt 2))<br />             (setq gjta (strcat "%%131" gjja))<br />           )<br />         )<br />         (setq oldg (subst (cons 1 gjta) gjje oldg))<br />         (entmod oldg)<br />       )<br />     )<br />     (if        (or (= (setq gjjb (substr gjt 2 1)) "\202")<br />             (= (setq gjjb (substr gjt 2 1)) "\203")<br />         )<br />       (progn<br />         (if (= gjjb "\202")<br />           (progn<br />             (setq gjjc (substr gjt 1 1))<br />             (setq gjja (substr gjt 3))<br />             (setq gjta (strcat gjjc "%%130" gjja))<br />           )<br />           (progn<br />             (setq gjjc (substr gjt 1 1))<br />             (setq gjja (substr gjt 3))<br />             (setq gjta (strcat gjjc "%%131" gjja))<br />           )<br />         )<br />         (setq oldg (subst (cons 1 gjta) gjje oldg))<br />         (entmod oldg)<br />       )<br />     )<br />     (if        (or (= (setq gjjb (substr gjt 3 1)) "\202")<br />             (= (setq gjjb (substr gjt 3 1)) "\203")<br />         )<br />       (progn<br />         (if (= gjjb "\202")<br />           (progn<br />             (setq gjjc (substr gjt 1 2))<br />             (setq gjja (substr gjt 4))<br />             (setq gjta (strcat gjjc "%%130" gjja))<br />           )<br />           (progn<br />             (setq gjjc (substr gjt 1 2))<br />             (setq gjja (substr gjt 4))<br />             (setq gjta (strcat gjjc "%%131" gjja))<br />           )<br />         )<br />         (setq oldg (subst (cons 1 gjta) gjje oldg))<br />         (entmod oldg)<br />       )<br />     )<br />     (setq n (1+ n))<br />   )<br /> )<br />

这是程序文件：

civil_liyan

☆当代活雷锋☆你好！文件下载了，可是运行时出现以下提示

; error: no function definition: DXF    未能成功。
但另一位好心人给我发了一份
作者是 甘燕良 的好用。
在此对二位表示感谢！

zhynt

呵呵，疏忽了，现在贴上：
(defun dxf (code elist)
  (cdr (assoc code elist))
)

将上面的代码加到程序里，或单独保存成ｌｓｐ文件，运行前加载。

civil_liyan

我将上二行代码加到了程序开始，运行正常。
谢谢雷锋同志！

zhynt

程序的原理是判断字符串的头三个是否为钢筋符号，至于第四个字符是否为钢筋符号我觉得没有必要，至少我还没有见过有配一百跟钢筋以上的。两为数的钢筋到时有的。
我自己觉得这个程序好像太烦琐了，主要是为了满足功能要求仓促间编成的，没有细细推敲。不知可否再简化一点。

大梦小生

斑竹能不能将修改后能用的程序再贴一下?小弟对编程一窍不通啊