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

增量刷

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

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

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

(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 . "???*"))))
            (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:45

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

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

(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:00

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

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

学习了。。

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

任意字符，包括汉字，从第四个开始递增attach://116327.gif

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

大神刷～

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

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

高手怎么这么多啊？
页: [1]
查看完整版本: 增量刷