本帖最后由 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等等


  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)



网友答:
  2. (defun c:tt (/ ent ent_data old_text new_text new_ent)
  3.   (vl-load-com)
  4.   (if (setq ent (car (entsel "\n选择要复制的多重引线: ")))
  5.     (progn
  6.       (setq ent_data (entget ent))
  7.       (if (setq old_text (cdr (assoc 302 ent_data)))
  8.         (progn
  9.           (if (numberp (read old_text))
  10.             (setq new_text (itoa (1+ (atoi old_text))))
  11.             (progn
  12.               (alert "错误：文本内容不是有效数字！")
  13.               (exit)
  14.             )
  15.           )
  16.           (command "_.copy" ent "" "0,0" "0,0")
  17.           (setq new_ent (entlast))
  18.           (setq new_ent_data (entget new_ent))
  19.           (setq new_ent_data
  20.             (subst (cons 302 new_text) (assoc 302 new_ent_data) new_ent_data)
  21.           )
  22.           (entmod new_ent_data)
  23.           (prompt "\n指定新位置: ")
  24.           (command "_.move" new_ent "" pause pause)
  25.         )
  26.         (alert "错误：未找到文本内容！")
  27.       )
  28.     )
  29.   )
  30.   (princ)
  31. )


网友答:
fangmin723 发表于 2025-4-27 14:10
引线内容的组码是302，你稍微修改修改就可以用了，使用vla-copy函数复制后，改下组码内容，然后使用vla-m ...

感谢您的指导，我这就去试试

网友答:
305341043 发表于 2025-4-26 10:44

引线内容的组码是302，你稍微修改修改就可以用了，使用vla-copy函数复制后，改下组码内容，然后使用vla-move移动就行

网友答: 阴线标注的会自动递增么?

网友答: 收藏了，谢谢

网友答:
jy06614998 发表于 2025-4-24 08:21
阴线标注的会自动递增么?

没有考虑引线，你可以试试，看看能否增加

网友答:
fangmin723 发表于 2025-4-24 11:23
没有考虑引线，你可以试试，看看能否增加

引线标注肯定行不通，已试过多次，多次请教大神无果

网友答:
305341043 发表于 2025-4-26 00:27
引线标注肯定行不通，已试过多次，多次请教大神无果

什么样的引线，截图或者上传个测试图看看

网友答:
fangmin723 发表于 2025-4-26 07:44
什么样的引线，截图或者上传个测试图看看


  • 上一篇：如何选择圆后自动删除与圆相交的水平线
  • 下一篇：没有了
    CAD技术交流中心 | 建筑CAD | 给排水CAD | 暖通CAD | 电气CAD | 电力CAD | 机械CAD | CAD母线槽 | CAD看图
    Copyright © 2019 - 2025