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