简单的焊缝编号递增复制

fangmin723

焊缝编号递增复制 快捷键《 DZFZ 》

多关键字[增(W)/减(S)/步减(Q)/步增(E)/括号(B) or 常规(R)/子级(D) or 父级(A)]

适用范围：A-Z单个字母开头，后面只有数字或者数字后面跟着-，-后面只有数字的字符串


如：B1；A10；D101；B1-1；A10-5；D101-50等等

1. ;;说明DZFZ)焊缝编号递增复制
   
2. (defun C:DZFZ(/ dxf dxflst endstr ent fnum index iskh iskhchange issub keywords matchstr prfix promptstr pt pt0 refpt setp snum startstr str tempstr txthig vet)
   
3.   (defun dxf(ent code)
   
4.     (if ent
   
5.       (progn
   
6.         (cond
   
7.           ((equal (type ent) 'ENAME) (setq ent (entget ent)))
   
8.           ((equal (type ent) 'VLA-OBJECT) (setq ent (entget (vlax-vla-object->ename ent))))
   
9.         )
   
10.         (cdr (assoc code ent))
    
11.       )
    
12.       (progn
    
13.         (princ "\n对象传入错误，传入图原名、组码表或VLA-OBJECT对象！")
    
14.         nil
    
15.       )
    
16.     )
    
17.   )
    
18.   (setq matchstr "[A-Z]#,[A-Z]##,[A-Z]###,[A-Z]#-#,[A-Z]#-##,[A-Z]#-###,[A-Z]##-#,[A-Z]##-##,[A-Z]##-###,[A-Z]###-#,[A-Z]###-##,[A-Z]###-###,([A-Z]#),([A-Z]##),([A-Z]###),([A-Z]#-#),([A-Z]#-##),([A-Z]#-###),([A-Z]##-#),([A-Z]##-##),([A-Z]##-###),([A-Z]###-#),([A-Z]###-##),([A-Z]###-###)")
    
19.   (if (and
    
20.         (progn
    
21.           (initget "E")
    
22.           (setq ent (entsel "\n拾取文字[输入内容(E)]:"))
    
23.           (if ent (if (= (type ent) 'STR) (setq ent (getstring "\n输入内容:")) (setq ent (car ent))))
    
24.         )
    
25.         (wcmatch
    
26.           (setq str
    
27.             (if (= (type ent) 'ENAME)
    
28.               (progn
    
29.                 (setq pt0 (dxf ent 11) refpt (getpoint "\n拾取参考点:"))
    
30.                 (setq vet (mapcar '- pt0 refpt))
    
31.                 (setq dxflst (entget ent))
    
32.                 (setq dxflst (vl-remove (assoc 5 dxflst) dxflst))
    
33.                 (dxf ent 1)
    
34.               )
    
35.               (progn
    
36.                 (setq
    
37.                   refpt (getpoint "\n拾取参考点:")
    
38.                   pt0 (getpoint refpt "\n拾取相对放置点:")
    
39.                   vet (mapcar '- pt0 refpt)
    
40.                   txthig (if (setq txthig (getreal "\n输入文字高度<3.5>:")) txthig 3.5)
    
41.                   dxflst (list '(0 . "TEXT") (cons 1 ent) (cons 10 pt0) (cons 11 pt0) (cons 40 txthig) '(41 . 0.7) '(71 . 0) '(72 . 4))
    
42.                 )
    
43.                 ent
    
44.               )
    
45.             )
    
46.           )
    
47.           matchstr
    
48.         )
    
49.       )
    
50.     (progn
    
51.       (setq
    
52.         iskh (wcmatch str "(*)")
    
53.         issub (wcmatch str "*-*")
    
54.         prfix (substr str (if iskh 2 1) 1)
    
55.         setp 1
    
56.         startstr (if iskh "(" "")
    
57.         endstr (if iskh ")" "")
    
58.       )
    
59.       (setq tempstr (vl-string-trim (strcat startstr prfix endstr) str))
    
60.       (if issub
    
61.         (setq
    
62.           index (vl-string-search "-" tempstr)
    
63.           fnum (atoi (substr tempstr 1 index))
    
64.           snum (atoi (substr tempstr (+ index 2)))
    
65.         )
    
66.         (setq fnum (atoi tempstr) snum 1)
    
67.       )
    
68.       (setq str
    
69.         (strcat startstr prfix
    
70.           (if issub
    
71.             (strcat (itoa fnum) "-" (itoa (setq snum (+ snum setp))))
    
72.             (itoa (setq fnum (+ fnum setp)))
    
73.           )
    
74.           endstr
    
75.         )
    
76.       )
    
77.       (cond
    
78.         ((and iskh issub) (setq promptstr "[增(W)/减(S)/步减(Q)/步增(E)/常规(R)/父级(A)]" keywords "W S Q E R A"))
    
79.         ((and iskh (not issub)) (setq promptstr "[增(W)/减(S)/步减(Q)/步增(E)/常规(R)/子级(D)]" keywords "W S Q E R D"))
    
80.         ((and issub (not iskh)) (setq promptstr "[增(W)/减(S)/步减(Q)/步增(E)/括号(B)/父级(A)]" keywords "W S Q E B A"))
    
81.         (t (setq promptstr "[增(W)/减(S)/步减(Q)/步增(E)/括号(B)/子级(D)]" keywords "W S Q E B D"))
    
82.       )
    
83.       (setq iskhchange nil)
    
84.       (while (progn (initget keywords) (setq pt (getpoint refpt (strcat "\n拾取放置点" promptstr "步长<" (itoa setp) ">,当前<" str ">:"))))
    
85.         (if (= (type pt) 'STR)
    
86.           (progn
    
87.             (setq pt (strcase pt))
    
88.             (cond
    
89.               ((equal pt "W") (if issub (setq snum (+ snum setp)) (setq fnum (+ fnum setp))))
    
90.               ((equal pt "S") (if issub (setq snum (if (< (- snum setp) 1) 1 (- snum setp))) (setq fnum (if (< (- fnum setp) 1) 1 (- fnum setp)))))
    
91.               ((equal pt "Q")
    
92.                 (setq setp (1- setp))
    
93.                 (if issub
    
94.                   (setq snum (if (< (1- snum) 1) 1 (1- snum)))
    
95.                   (setq fnum (if (< (1- fnum) 1) 1 (1- fnum)))
    
96.                 )
    
97.               )
    
98.               ((equal pt "E")
    
99.                 (setq setp (1+ setp))
    
100.                 (if issub (setq snum (1+ snum)) (setq fnum (1+ fnum)))
     
101.               )
     
102.               ((equal pt "R") (setq iskh nil)
     
103.                 (if iskhchange
     
104.                   (progn
     
105.                     (if issub
     
106.                       (setq snum (+ snum setp))
     
107.                       (setq fnum (+ fnum setp))
     
108.                     )
     
109.                     (setq iskhchange nil)
     
110.                   )
     
111.                 )
     
112.               )
     
113.               ((equal pt "B") (setq iskh T)
     
114.                 (if (not iskhchange)
     
115.                   (progn
     
116.                     (if issub
     
117.                       (setq snum (if (< (- snum setp) 1) 1 (- snum setp)))
     
118.                       (setq fnum (if (< (- fnum setp) 1) 1 (- fnum setp)))
     
119.                     )
     
120.                     (setq iskhchange t)
     
121.                   )
     
122.                 )
     
123.               )
     
124.               ((equal pt "A") (setq issub nil fnum (+ fnum setp)))
     
125.               ((equal pt "D") (setq issub T))
     
126.             )
     
127.             (setq
     
128.               startstr (if iskh "(" "") endstr (if iskh ")" "")
     
129.               str
     
130.               (strcat startstr prfix
     
131.                 (if issub
     
132.                   (strcat (itoa fnum) "-" (itoa snum))
     
133.                   (itoa fnum)
     
134.                 )
     
135.                 endstr
     
136.               )
     
137.             )
     
138.           )
     
139.           (progn
     
140.             (setq iskhchange nil)
     
141.             (if (not issub) (setq snum 1))
     
142.             (setq dxflst (subst (cons 1 str) (assoc 1 dxflst) dxflst))
     
143.             (setq pt (mapcar '+ pt vet))
     
144.             (setq dxflst (subst (cons 10 pt) (assoc 10 dxflst) dxflst))
     
145.             (setq dxflst (subst (cons 11 pt) (assoc 11 dxflst) dxflst))
     
146.             (entmake dxflst)
     
147.             (setq str
     
148.               (strcat startstr prfix
     
149.                 (if issub
     
150.                   (strcat (itoa fnum) "-" (itoa (setq snum (+ snum setp))))
     
151.                   (itoa (setq fnum (+ fnum setp)))
     
152.                 )
     
153.                 endstr
     
154.               )
     
155.             )
     
156.           )
     
157.         )
     
158.         (cond
     
159.           ((and iskh issub) (setq promptstr "[增(W)/减(S)/步减(Q)/步增(E)/常规(R)/父级(A)]" keywords "W S Q E R A"))
     
160.           ((and iskh (not issub)) (setq promptstr "[增(W)/减(S)/步减(Q)/步增(E)/常规(R)/子级(D)]" keywords "W S Q E R D"))
     
161.           ((and issub (not iskh)) (setq promptstr "[增(W)/减(S)/步减(Q)/步增(E)/括号(B)/父级(A)]" keywords "W S Q E B A"))
     
162.           (t (setq promptstr "[增(W)/减(S)/步减(Q)/步增(E)/括号(B)/子级(D)]" keywords "W S Q E B D"))
     
163.         )
     
164.       )
     
165.     )
     
166.   )
     
167.   (prin1)
     
168. )
     
169. (princ "\n焊缝编号递增复制 快捷键《 DZFZ 》\n适用范围：A-Z单个字母开头，后面只有数字或者数字后面跟着-，-后面只有数字的字符串\n如：B1；A10；D101；B1-1；A10-5；D101-50；等等")
     
170. (prin1)

;;说明<img src="static/image/smiley/default/sad.gif" smilieid="2" border="0" alt="" />DZFZ)焊缝编号递增复制<br /> (defun C:DZFZ(/ dxf dxflst endstr ent fnum index iskh iskhchange issub keywords matchstr prfix promptstr pt pt0 refpt setp snum startstr str tempstr txthig vet)<br />   (defun dxf(ent code)<br />     (if ent<br />       (progn<br />         (cond<br />           ((equal (type ent) 'ENAME) (setq ent (entget ent)))<br />           ((equal (type ent) 'VLA-OBJECT) (setq ent (entget (vlax-vla-object->ename ent))))<br />         )<br />         (cdr (assoc code ent))<br />       )<br />       (progn<br />         (princ "\n对象传入错误，传入图原名、组码表或VLA-OBJECT对象！")<br />         nil<br />       )<br />     )<br />   )<br />   (setq matchstr "[A-Z]#,[A-Z]##,[A-Z]###,[A-Z]#-#,[A-Z]#-##,[A-Z]#-###,[A-Z]##-#,[A-Z]##-##,[A-Z]##-###,[A-Z]###-#,[A-Z]###-##,[A-Z]###-###,([A-Z]#),([A-Z]##),([A-Z]###),([A-Z]#-#),([A-Z]#-##),([A-Z]#-###),([A-Z]##-#),([A-Z]##-##),([A-Z]##-###),([A-Z]###-#),([A-Z]###-##),([A-Z]###-###)")<br />   (if (and<br />         (progn<br />           (initget "E")<br />           (setq ent (entsel "\n拾取文字[输入内容(E)]:"))<br />           (if ent (if (= (type ent) 'STR) (setq ent (getstring "\n输入内容:")) (setq ent (car ent))))<br />         )<br />         (wcmatch <br />           (setq str<br />             (if (= (type ent) 'ENAME) <br />               (progn<br />                 (setq pt0 (dxf ent 11) refpt (getpoint "\n拾取参考点:"))<br />                 (setq vet (mapcar '- pt0 refpt))<br />                 (setq dxflst (entget ent))<br />                 (setq dxflst (vl-remove (assoc 5 dxflst) dxflst))<br />                 (dxf ent 1)<br />               )<br />               (progn<br />                 (setq<br />                   refpt (getpoint "\n拾取参考点:")<br />                   pt0 (getpoint refpt "\n拾取相对放置点:")<br />                   vet (mapcar '- pt0 refpt)<br />                   txthig (if (setq txthig (getreal "\n输入文字高度<3.5>:")) txthig 3.5)<br />                   dxflst (list '(0 . "TEXT") (cons 1 ent) (cons 10 pt0) (cons 11 pt0) (cons 40 txthig) '(41 . 0.7) '(71 . 0) '(72 . 4))<br />                 )<br />                 ent<br />               )<br />             )<br />           )<br />           matchstr<br />         )<br />       )<br />     (progn<br />       (setq<br />         iskh (wcmatch str "(*)")<br />         issub (wcmatch str "*-*")<br />         prfix (substr str (if iskh 2 1) 1)<br />         setp 1<br />         startstr (if iskh "(" "")<br />         endstr (if iskh ")" "")<br />       )<br />       (setq tempstr (vl-string-trim (strcat startstr prfix endstr) str))<br />       (if issub <br />         (setq<br />           index (vl-string-search "-" tempstr)<br />           fnum (atoi (substr tempstr 1 index))<br />           snum (atoi (substr tempstr (+ index 2)))<br />         )<br />         (setq fnum (atoi tempstr) snum 1)<br />       )<br />       (setq str<br />         (strcat startstr prfix <br />           (if issub<br />             (strcat (itoa fnum) "-" (itoa (setq snum (+ snum setp))))<br />             (itoa (setq fnum (+ fnum setp)))<br />           )<br />           endstr<br />         )<br />       )<br />       (cond<br />         ((and iskh issub) (setq promptstr "[增(W)/减(S)/步减(Q)/步增(E)/常规(R)/父级(A)]" keywords "W S Q E R A"))<br />         ((and iskh (not issub)) (setq promptstr "[增(W)/减(S)/步减(Q)/步增(E)/常规(R)/子级(D)]" keywords "W S Q E R D"))<br />         ((and issub (not iskh)) (setq promptstr "[增(W)/减(S)/步减(Q)/步增(E)/括号(B)/父级(A)]" keywords "W S Q E B A"))<br />         (t (setq promptstr "[增(W)/减(S)/步减(Q)/步增(E)/括号(B)/子级(D)]" keywords "W S Q E B D"))<br />       )<br />       (setq iskhchange nil)<br />       (while (progn (initget keywords) (setq pt (getpoint refpt (strcat "\n拾取放置点" promptstr "步长<" (itoa setp) ">,当前<" str ">:"))))<br />         (if (= (type pt) 'STR)<br />           (progn<br />             (setq pt (strcase pt))<br />             (cond<br />               ((equal pt "W") (if issub (setq snum (+ snum setp)) (setq fnum (+ fnum setp))))<br />               ((equal pt "S") (if issub (setq snum (if (< (- snum setp) 1) 1 (- snum setp))) (setq fnum (if (< (- fnum setp) 1) 1 (- fnum setp)))))<br />               ((equal pt "Q")<br />                 (setq setp (1- setp))<br />                 (if issub<br />                   (setq snum (if (< (1- snum) 1) 1 (1- snum)))<br />                   (setq fnum (if (< (1- fnum) 1) 1 (1- fnum)))<br />                 )<br />               )<br />               ((equal pt "E")<br />                 (setq setp (1+ setp))<br />                 (if issub (setq snum (1+ snum)) (setq fnum (1+ fnum)))<br />               )<br />               ((equal pt "R") (setq iskh nil)<br />                 (if iskhchange<br />                   (progn<br />                     (if issub<br />                       (setq snum (+ snum setp))<br />                       (setq fnum (+ fnum setp))<br />                     )<br />                     (setq iskhchange nil)<br />                   )<br />                 )<br />               )<br />               ((equal pt "B") (setq iskh T)<br />                 (if (not iskhchange)<br />                   (progn<br />                     (if issub<br />                       (setq snum (if (< (- snum setp) 1) 1 (- snum setp)))<br />                       (setq fnum (if (< (- fnum setp) 1) 1 (- fnum setp)))<br />                     )<br />                     (setq iskhchange t)<br />                   )<br />                 )<br />               )<br />               ((equal pt "A") (setq issub nil fnum (+ fnum setp)))<br />               ((equal pt "D") (setq issub T))<br />             )<br />             (setq<br />               startstr (if iskh "(" "") endstr (if iskh ")" "")<br />               str<br />               (strcat startstr prfix <br />                 (if issub<br />                   (strcat (itoa fnum) "-" (itoa snum))<br />                   (itoa fnum)<br />                 )<br />                 endstr<br />               )<br />             )<br />           )<br />           (progn<br />             (setq iskhchange nil)<br />             (if (not issub) (setq snum 1))<br />             (setq dxflst (subst (cons 1 str) (assoc 1 dxflst) dxflst))<br />             (setq pt (mapcar '+ pt vet))<br />             (setq dxflst (subst (cons 10 pt) (assoc 10 dxflst) dxflst))<br />             (setq dxflst (subst (cons 11 pt) (assoc 11 dxflst) dxflst))<br />             (entmake dxflst)<br />             (setq str<br />               (strcat startstr prfix <br />                 (if issub<br />                   (strcat (itoa fnum) "-" (itoa (setq snum (+ snum setp))))<br />                   (itoa (setq fnum (+ fnum setp)))<br />                 )<br />                 endstr<br />               )<br />             )<br />           )<br />         )<br />         (cond<br />           ((and iskh issub) (setq promptstr "[增(W)/减(S)/步减(Q)/步增(E)/常规(R)/父级(A)]" keywords "W S Q E R A"))<br />           ((and iskh (not issub)) (setq promptstr "[增(W)/减(S)/步减(Q)/步增(E)/常规(R)/子级(D)]" keywords "W S Q E R D"))<br />           ((and issub (not iskh)) (setq promptstr "[增(W)/减(S)/步减(Q)/步增(E)/括号(B)/父级(A)]" keywords "W S Q E B A"))<br />           (t (setq promptstr "[增(W)/减(S)/步减(Q)/步增(E)/括号(B)/子级(D)]" keywords "W S Q E B D"))<br />         )<br />       )<br />     )<br />   )<br />   (prin1)<br /> )<br /> (princ "\n焊缝编号递增复制 快捷键《 DZFZ 》\n适用范围：A-Z单个字母开头，后面只有数字或者数字后面跟着-，-后面只有数字的字符串\n如：B1；A10；D101；B1-1；A10-5；D101-50；等等")<br /> (prin1)