[LISP程序]：自制PKPM用的一些LISP程序。

YueFeng

先发布PKPM梁、柱自动排序LISP程序。这是修改后的LISP程序。

2. 
   
3.   [FONT=courier new]
   
4. ;;月枫PKPM工具集程序;
   
5. ;;自动排序函数.
   
6. 
   
7. (Defun C:ZDPX(/ PLZZB S1 DA TE SZ TT SA L1 N1 DATA WZNR JYMC JYMN OLDXH PLZJB PLZZC L2 BASE ZJZ NAM SEN NAM1 NEW1)
   
8.    ;加载晓东API.
   
9.    (ArxLoad "XDRX_API15.ARX")
   
10.    (SetQ PLZZB Nil)
    
11.    ;选择要排序的对象.
    
12.    (SetQ S1 (XDRX_EntSel "\n请选择要排列的对象" '((0 . "TEXT")));所选中的对象必须为文字.
    
13.          DA (EntGet (Car S1));对象的DXF组码.
    
14.          TE (Cdr (Assoc 1 DA));对象文字的内容.
    
15.          SZ (XDRX_String_FindOneOf TE "0123456789");查出该对象文字内容中是否含有数字.
    
16.    )
    
17.    ;判断对象文字内容中是否含有数字.
    
18.    (If (Not SZ)
    
19.       (Progn
    
20.          (Alert "所选中文字没有任何数字,不能进行排序操作!")
    
21.          (Exit)
    
22.       )
    
23.    )
    
24.    (SetQ TT (XDRX_String_Left TE SZ));取出该对象文字内容中不含有数字的前部分.
    
25.    (Prompt "请选择要进行排序的对象[ALL=全选]")
    
26.    (SetQ SA (SsGet '((0 . "TEXT")));选择所有要进行排序操作的文字对象.
    
27.          L1 (SsLength SA)
    
28.          N1 0
    
29.    )
    
30.    ;将所有与选中对象相同前缀的文字进行筛选.
    
31.    (Repeat L1
    
32.       (SetQ Data (EntGet (SsName SA N1));选择集中对象的DXF组码.
    
33.             WZNR (Cdr (Assoc 1 Data));该对象文字内容.
    
34.             JYMC (XDRX_String_FindOneOf WZNR "0123456789")
    
35.             JYMN (XDRX_String_Left WZNR JYMC)
    
36.       )
    
37.       (If (= JYMN TT)
    
38.          (Progn
    
39.             (SetQ OLDXH (AToI (XDRX_String_Remove WZNR 0 JYMC))
    
40.                   PLZJB (List OLDXH N1)
    
41.             )
    
42.             (If (= Nil PLZZB)
    
43.                (SetQ PLZZB (List PLZJB))
    
44.                (SetQ PLZZB (Cons PLZJB PLZZB))
    
45.             )   
    
46.             )
    
47.          )
    
48.       (SetQ N1 (1+ N1))
    
49.    )
    
50.    ;将筛选后的对象按序号从小到大排列.
    
51.    (SetQ PXZZC (Car (Apply 'XDRX_RListSort2 PLZZB))
    
52.          L2 (Length PXZZC)
    
53.          N1 0
    
54.          Base (GetInt "\n请输入排序的开始号:")
    
55.    )
    
56.    (If (<= Base 0)
    
57.       (Progn
    
58.          (Alert "输入排序的开始号小于0!")
    
59.          (Exit)
    
60.       )
    
61.    )   
    
62.    (Repeat L2
    
63.       (SetQ ZJZ (Nth N1 PXZZC)
    
64.             Nam (Fix (Car ZJZ))
    
65.             SEN (Fix (Cadr ZJZ))
    
66.             Data (EntGet (SsName SA SEN))
    
67.       )
    
68.       (If (/= N1 0)
    
69.          (Progn
    
70.             (SetQ Nam1 (Fix (Car (Nth (1- N1) PXZZC))))
    
71.             (If (/= Nam Nam1)(SetQ Base (1+ Base)))
    
72.          )
    
73.       )
    
74.       (SetQ NEW1 (StrCat TT (IToA Base))
    
75.             Data (Subst (Cons 1 NEW1) (Assoc 1 Data) Data)
    
76.       )
    
77.       (EntMod Data)
    
78.       (SetQ N1 (1+ N1))
    
79.    )
    
80.    (Prompt (StrCat "本次操作后最大号为:" NEW1 "!"))
    
81. )
    
82.   [/FONT]
    

<br />   [FONT=courier new]<br /> ;;月枫PKPM工具集程序;<br /> ;;自动排序函数.<br /> <br /> (Defun C:ZDPX(/ PLZZB S1 DA TE SZ TT SA L1 N1 DATA WZNR JYMC JYMN OLDXH PLZJB PLZZC L2 BASE ZJZ NAM SEN NAM1 NEW1)<br />    ;加载晓东API.<br />    (ArxLoad "XDRX_API15.ARX")<br />    (SetQ PLZZB Nil)<br />    ;选择要排序的对象.<br />    (SetQ S1 (XDRX_EntSel "\n请选择要排列的对象" '((0 . "TEXT")));所选中的对象必须为文字.<br />          DA (EntGet (Car S1));对象的DXF组码.<br />          TE (Cdr (Assoc 1 DA));对象文字的内容.<br />          SZ (XDRX_String_FindOneOf TE "0123456789");查出该对象文字内容中是否含有数字.<br />    )<br />    ;判断对象文字内容中是否含有数字.<br />    (If (Not SZ)<br />       (Progn<br />          (Alert "所选中文字没有任何数字,不能进行排序操作!")<br />          (Exit)<br />       )<br />    )<br />    (SetQ TT (XDRX_String_Left TE SZ));取出该对象文字内容中不含有数字的前部分.<br />    (Prompt "请选择要进行排序的对象[ALL=全选]")<br />    (SetQ SA (SsGet '((0 . "TEXT")));选择所有要进行排序操作的文字对象.<br />          L1 (SsLength SA)<br />          N1 0<br />    )<br />    ;将所有与选中对象相同前缀的文字进行筛选.<br />    (Repeat L1<br />       (SetQ Data (EntGet (SsName SA N1));选择集中对象的DXF组码.<br />             WZNR (Cdr (Assoc 1 Data));该对象文字内容.<br />             JYMC (XDRX_String_FindOneOf WZNR "0123456789")<br />             JYMN (XDRX_String_Left WZNR JYMC)<br />       )<br />       (If (= JYMN TT)<br />          (Progn<br />             (SetQ OLDXH (AToI (XDRX_String_Remove WZNR 0 JYMC))<br />                   PLZJB (List OLDXH N1)<br />             )<br />             (If (= Nil PLZZB)<br />                (SetQ PLZZB (List PLZJB))<br />                (SetQ PLZZB (Cons PLZJB PLZZB))<br />             )   <br />             )<br />          )<br />       (SetQ N1 (1+ N1))<br />    )<br />    ;将筛选后的对象按序号从小到大排列.<br />    (SetQ PXZZC (Car (Apply 'XDRX_RListSort2 PLZZB))<br />          L2 (Length PXZZC)<br />          N1 0<br />          Base (GetInt "\n请输入排序的开始号:")<br />    )<br />    (If (<= Base 0)<br />       (Progn<br />          (Alert "输入排序的开始号小于0!")<br />          (Exit)<br />       )<br />    )   <br />    (Repeat L2<br />       (SetQ ZJZ (Nth N1 PXZZC)<br />             Nam (Fix (Car ZJZ))<br />             SEN (Fix (Cadr ZJZ))<br />             Data (EntGet (SsName SA SEN))<br />       )<br />       (If (/= N1 0)<br />          (Progn<br />             (SetQ Nam1 (Fix (Car (Nth (1- N1) PXZZC))))<br />             (If (/= Nam Nam1)(SetQ Base (1+ Base)))<br />          )<br />       )<br />       (SetQ NEW1 (StrCat TT (IToA Base))<br />             Data (Subst (Cons 1 NEW1) (Assoc 1 Data) Data)<br />       )<br />       (EntMod Data)<br />       (SetQ N1 (1+ N1))<br />    )<br />    (Prompt (StrCat "本次操作后最大号为:" NEW1 "!"))<br /> )<br />   [/FONT]<br />

YueFeng

主要用于一级钢与二级钢之间的切换。
此程序不需要XDRX_API支持。

2. 
   
3.   [FONT=courier new]
   
4. (Defun C:YF_GJQH(/ Sel1 Len1 N1 Data OLD1 NEW1 NEW2 NEW3 NEW4)
   
5.    (While (Not (SetQ Sel1 (SsGet '((0 . "TEXT"))))))
   
6.    (SetQ Len1 (SsLength Sel1)
   
7.          N1 0
   
8.    )
   
9.    (Repeat Len1
   
10.       (SetQ Data (EntGet (SsName Sel1 N1))
    
11.             N1 (1+ N1)
    
12.             OLD1 (Cdr (Assoc 1 Data))
    
13.             NEW1 (Vl-String-Subst (Chr 130) (Chr 131) OLD1)
    
14.             NEW2 (Vl-String-Subst (Chr 131) (Chr 130) OLD1)
    
15.             NEW3 (Vl-String-Subst "%%130" "%%131" OLD1)
    
16.             NEW4 (Vl-String-Subst "%%131" "%%130" OLD1)
    
17.       )
    
18.       (If (/= OLD1 NEW1)(SetQ Data (Subst (Cons 1 NEW1) (Cons 1 OLD1) Data)))
    
19.       (If (/= OLD1 NEW2)(SetQ Data (Subst (Cons 1 NEW2) (Cons 1 OLD1) Data)))
    
20.       (If (/= OLD1 NEW3)(SetQ Data (Subst (Cons 1 NEW3) (Cons 1 OLD1) Data)))
    
21.       (If (/= OLD1 NEW4)(SetQ Data (Subst (Cons 1 NEW4) (Cons 1 OLD1) Data)))
    
22.       (EntMod Data)
    
23.   )
    
24.    (Prin1)
    
25. )   
    
26.   [/FONT]
    

<br />   [FONT=courier new]<br /> (Defun C:YF_GJQH(/ Sel1 Len1 N1 Data OLD1 NEW1 NEW2 NEW3 NEW4)<br />    (While (Not (SetQ Sel1 (SsGet '((0 . "TEXT"))))))<br />    (SetQ Len1 (SsLength Sel1)<br />          N1 0<br />    )<br />    (Repeat Len1<br />       (SetQ Data (EntGet (SsName Sel1 N1))<br />             N1 (1+ N1)<br />             OLD1 (Cdr (Assoc 1 Data))<br />             NEW1 (Vl-String-Subst (Chr 130) (Chr 131) OLD1)<br />             NEW2 (Vl-String-Subst (Chr 131) (Chr 130) OLD1)<br />             NEW3 (Vl-String-Subst "%%130" "%%131" OLD1)<br />             NEW4 (Vl-String-Subst "%%131" "%%130" OLD1)<br />       )<br />       (If (/= OLD1 NEW1)(SetQ Data (Subst (Cons 1 NEW1) (Cons 1 OLD1) Data)))<br />       (If (/= OLD1 NEW2)(SetQ Data (Subst (Cons 1 NEW2) (Cons 1 OLD1) Data)))<br />       (If (/= OLD1 NEW3)(SetQ Data (Subst (Cons 1 NEW3) (Cons 1 OLD1) Data)))<br />       (If (/= OLD1 NEW4)(SetQ Data (Subst (Cons 1 NEW4) (Cons 1 OLD1) Data)))<br />       (EntMod Data)<br />   )<br />    (Prin1)<br /> )   <br />   [/FONT]<br />