增量刷

刘炎华 · 发表于 2021-11-2 21:32

本帖最后由刘炎华于 2023-3-9 22:08 编辑

求助高手，想求一个增量刷，感谢！！！

yshf · 发表于 2021-11-2 21:32

(defun c:zmdz()
 (defun Nume->To->Alph(Xnum / zfc M K )
 (setq zfc "")
 (while (> Xnum 0)
 (setq M (fix (/ Xnum 26)))
 (setq K (- Xnum (* M 26)))
 (if (= K 0)
 (setq K 26
 M (1- M)
 )
 )
 (setq zfc (strcat (chr (+ 64 K)) zfc))
 (setq Xnum M)

 )
 (setq zfc zfc)
)

(setvar "cmdecho" 0)
(command "_undo" "Be")
(if (and
 (princ "\n选取第1个单行文字:")
 (setq ssa (ssget ":S" '((0 . "TEXT") (1 . "???[A-Z]*"))))
 (princ "\n选取其它单行文字:")
 (setq ssb (ssget '((0 . "TEXT"))))
 )
 (progn
 (setq ent1 (ssname ssa 0))
 (setq zfc (cdr (assoc 1 (entget ent1))))
 (setq zfc1 (substr zfc 1 3)) ;取前3个字符
 (setq zfc2 (substr zfc 4 1)) ;取第4个字符
 (setq zfc3 (substr zfc 5)) ;取从第5个起剩余的字符
 (setq qsz (- (ascii zfc2) 64)) ;第4个字符的ASCII码值-1
 ;取选集内所有对象
 (setq tymbb (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssb))))
 ;按X坐标值由小到大排序
 (setq tymbb (vl-sort tymbb '(lambda(a b)
 (setq pta (assoc 10 (entget a)))
 (setq ptb (assoc 10 (entget b)))
 (< (cadr pta) (cadr ptb))
 )
 )
 )
 (setq i 1)
 (foreach enti tymbb
 (setq dxfi (entget enti))
 (setq dxfi (subst (cons 1 (strcat zfc1 (Nume->To->Alph (+ qsz i)) zfc3))
 (assoc 1 dxfi)
 dxfi
 )
 )
 (entmod dxfi)
 (setq i (1+ i))
 )
 )
)
(command "_undo" "e")
(setvar "cmdecho" 1)
(princ)
)

tigcat · 发表于 2021-11-2 23:14

天正建筑有个文字递增的功能可以实现

松树的松 · 发表于 2021-11-3 08:57

(defun c:ttt (/ is_gr4 n1 n2 n3 obj1 obj2 pause pt1 pt111 pt2 ss1 str1 str2 str3 str5)
;;;选择文字
(setq ss1 (ssget ":E:S" '((0 . "text"))))
(if ss1
(progn (setq obj1 (vlax-ename->vla-object (ssname ss1 0))
;;;获取文字内容
str1 (vla-get-textstring obj1)
;;;获取文字坐标
pt1 (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint obj1)))
)
;;;;获取文字长度
(setq n1 (strlen str1)
;;;获取asc码
n2 (ascii (substr str1 (- n1 2) 1))
)
;;;--------------------------------------------------------------
;;; 判断文字结尾是否为数字或字母
;;;--------------------------------------------------------------
(cond
;;;-----------------------------------大写字母----------------------------
;;;判断最后一个字符是否为大写字母A~Z
((and (> n2 64) (< n2 90))
(setq n3 (ascii (substr str1 (- n1 2) 1))) ;-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;开始递增复制
;-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;获取字符中的前半部分
(setq str2 (substr str1 1 (- (strlen str1) 3)))
;;;获取字符中的后半部分
(setq str5 (substr str1 5 2))
;;;计算加1，重置参考点，重新创建文字内容
(setq n3 (+ n3 1))
(setq str3 (strcat str2 (chr n3) str5))
(setq obj2 (vlax-vla-object->ename obj1)
is_gr4 1
)
(while (and is_gr4 (> n3 64) (< n3 91))
(setq pt111 (getvar "LastPoint"))
(command "_copy" obj2 "" pt1 pause)
(setq pt2 (getvar "LastPoint"))
;;判断最后一点与前一点是否一样
(if (< (distance pt111 pt2) 0.1)
(progn
;;;设置退出循环
(setq is_gr4 nil)
;;;删除最后生成的文字
(entdel (entlast))
)
(progn
;;;提取复制创建的文字
(setq obj2 (entlast))
;;;修改文字内容
(vla-put-textstring (vlax-ename->vla-object obj2) str3)
;;;计算加1，重置参考点，重新创建文字内容
(setq n3 (+ n3 1)
pt1 pt2
str3 (strcat str2 (chr n3) str5)
)
)
)
)
)
;;;-----------------------------------大写字母----------------------------
)
;;;----------cond
)
)
)

(defun c:ttt (/ is_gr4 n1 n2 n3 obj1 obj2 pause pt1 pt111 pt2 ss1 str1 str2 str3 str5) 
;;;选择文字 
  (setq ss1 (ssget ":E:S" '((0 . "text")))) 
  (if ss1 
    (progn (setq obj1 (vlax-ename->vla-object (ssname ss1 0)) 
;;;获取文字内容 
                 str1 (vla-get-textstring obj1) 
;;;获取文字坐标 
                 pt1  (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint obj1))) 
           ) 
;;;;获取文字长度 
           (setq n1 (strlen str1) 
;;;获取asc码 
                 n2 (ascii (substr str1 (- n1 2) 1)) 
           ) 
;;;-------------------------------------------------------------- 
;;;       判断文字结尾是否为数字或字母 
;;;-------------------------------------------------------------- 
           (cond 
;;;-----------------------------------大写字母----------------------------        
;;;判断最后一个字符是否为大写字母A~Z 
                 ((and (> n2 64) (< n2 90)) 
                  (setq n3 (ascii (substr str1 (- n1 2) 1))) ;-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
                    ;开始递增复制 
                    ;-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;;;获取字符中的前半部分 
                  (setq str2 (substr str1 1 (- (strlen str1) 3))) 
;;;获取字符中的后半部分 
                  (setq str5 (substr str1 5 2)) 
;;;计算加1，重置参考点，重新创建文字内容 
                  (setq n3 (+ n3 1)) 
                  (setq str3 (strcat str2 (chr n3) str5)) 
                  (setq        obj2   (vlax-vla-object->ename obj1) 
                        is_gr4 1 
                  ) 
                  (while (and is_gr4 (> n3 64) (< n3 91)) 
                    (setq pt111 (getvar "LastPoint")) 
                    (command "_copy" obj2 "" pt1 pause) 
                    (setq pt2 (getvar "LastPoint")) 
                    ;;判断最后一点与前一点是否一样           
                    (if        (< (distance pt111 pt2) 0.1) 
                      (progn 
;;;设置退出循环 
                             (setq is_gr4 nil) 
;;;删除最后生成的文字 
                             (entdel (entlast)) 
                      ) 
                      (progn 
;;;提取复制创建的文字 
                             (setq obj2 (entlast)) 
;;;修改文字内容 
                             (vla-put-textstring (vlax-ename->vla-object obj2) str3) 
;;;计算加1，重置参考点，重新创建文字内容 
                             (setq n3        (+ n3 1) 
                                   pt1        pt2 
                                   str3        (strcat str2 (chr n3) str5) 
                             ) 
                      ) 
                    ) 
                  ) 
                 ) 
;;;-----------------------------------大写字母---------------------------- 
           ) 
;;;----------cond 
    ) 
  ) 
)

松树的松 · 发表于 2021-11-3 09:04

看看效果如何。。。。:D

hh_lj007 · 发表于 2021-11-3 11:11

学习了。。

guosheyang · 发表于 2021-11-3 22:43

任意字符，包括汉字，从第四个开始递增http://bbs.mjtd.com/forum.php?mod=attachment&aid=MTE2MzI3fDhhM2RkNGVmNDhiOTM1ZWUyY2JhMTNlMzQ3NWNkOGVjfDE3MTQ5OTkwMjI%3D&request=yes&_f=.gif

czb203 · 发表于 2021-11-5 19:04

大神刷～

yyz639 · 发表于 2021-11-9 14:33

zmzk · 发表于 2022-12-9 09:37

高手怎么这么多啊？

账号		自动登录	找回密码
密码			注册

[源码] 增量刷

最佳答案

点评

本帖子中包含更多资源

点评

本帖子中包含更多资源