求一复制递增字母和数字的程序

偏爱云~小吴 · 发表于 2013-11-9 12:21

现在只有复制递增数字和原位字母递增的程序，求一整合版，字母和数字都可以递增复制

偏爱云~小吴 · 发表于 2013-11-9 12:34

(defun c:zf (/       fun_setini fun_close  fun_error  FUN_GETdigit       old_error old_DIMZIN ureal    last_ent
   Plus1       String_To_Numbers    buchang1 $buchang    SS       SS1          e0    ent
   PT       i loop    ENTL       E-1    NEWTX       ENT_TMP
   )
  (defun fun_setini ()
(setq old_error *error*
   old_DIMZIN(getvar "DIMZIN")
   *error* fun_error
)
(or NBTV_TXT_CopyADD (setq NBTV_TXT_CopyADD 1.0))
(setvar "cmdecho" 0)
(setvar "DIMZIN" 0)
(vl-cmdf "_.undo" "be")
  )
  (defun fun_error (msg) (princ msg) (fun_close))
  (defun fun_close () (vl-cmdf "_.undo" "e") (setvar "DIMZIN" old_DIMZIN)(setvar "cmdecho" 1) (setq *error* old_error))
  (defun ureal (bit kwd msg def / inp)
(if def
   (setq msg (strcat "\n" msg "<" (rtos def 2) ">: ")
      bit (* 2 (fix (/ bit 2)))
   )
   (setq msg (strcat "\n" msg ": "))
)
(initget bit kwd)
(setq inp (getreal msg))
(if inp
   inp
   def
)
  )
  (defun String_To_Numbers (inStr
      ;;Input string
      / Flush_Buf Res
      ;;Result list
      Buf
      ;;String buffer
      Inx
      ;;Character location
      CH
      ;;Character
) (defun Flush_Buf ()
   (if (not (wcmatch Buf "[+-.]")) ;is it not just +-. ;[...] 匹配括号中的任意一个字符

(progn ;Clean it up first
   (if (= (substr Buf 1 1) ".")
      (setq Buf (strcat "0" Buf))
   )
   ;;add zero to front if .#    ;# (磅值符号)匹配任意单个数值字符,. (句号)
匹配任意单个非字母数值字符

   (if (= (substr Buf (strlen Buf)) ".")
      (setq Buf (substr Buf 1 (1- (strlen Buf))))
   )
   ;;remove decimal if #.
;Add to RES list
   (setq RES (cons Buf RES))
)
   )
   (setq Buf "")
   ;;reset Buf
)
(setq Inx 1 ;start at the beginning of the string
   Buf "" ;init buffer to empty
) ;
; Loop until the end of the string.
; (I indicates where we are in the string)
;
(while (<= Inx (strlen inStr)) ;
; Get the character at position Inx, increment position indicator
   (setq CH (substr inStr Inx 1)
      Inx (1+ Inx)
   ) ;
   (cond ; Test to see if character is a digit.
((wcmatch CH "[0-9.]")
   (if (= CH ".") ;is it decimal
   (if (not (wcmatch Buf "*`.*")) ;not already in there
      (setq Buf (strcat Buf CH))
      (Flush_Buf)
   ) ;
   (setq Buf (strcat Buf CH))
   )
)
((= Buf "") ;is the buffer empty
;Is CH minus
   (if (= CH "-")
   (setq Buf CH) ;Yes, save in Buf
   )
)
('T ;else buffer is not empty
   (Flush_Buf)
   (if (= CH "-")
   (setq Buf CH)
   )
)
   ) ; End of COND
) ; End of WHILE
;
(if (and (/= Buf "") (not (wcmatch Buf "[+-.]")))
   (Flush_Buf)
)
(reverse Res)
  )
  (defun FUN_GETdigit (sNum)
(IF (vl-string-search "." sNum)
   (STRLEN (substr sNum (+ 2 (vl-string-search "." sNum))))
   0
)
  )
  (defun Plus1 (str buchang / d1 d2 h num1 num2)
(setq str (vl-string-translate "-" (chr 1) str))
(or (setq d1 (last (string_to_numbers str))) (setq d1 "0"))
(setq h (vl-string-right-trim d1 str))
(setq num1 (FUN_GETdigit d1))
(setq d2 (vl-string-right-trim "." (vl-string-right-trim "0" (RTOS (+ (read d1) buchang) 2 12))))
(setq num2 (FUN_GETdigit d2))
(if (and (= num2 0) (> num1 0))
   (setq d2 (strcat d2 "."))
)
(repeat (- num1 num2) (setq d2 (strcat d2 "0")))
;;(setq d2 (vl-princ-to-string (+ (read d1) buchang)))
(while (< (strlen d2) (strlen d1)) (setq d2 (strcat "0" d2)))
(vl-string-translate (chr 1) "-" (strcat h d2))
  )
  (defun last_ent (en / ss)
(if en
   (progn (setq ss (ssadd))
      (while (setq en (entnext en))
         (if (not (member (cdr (assoc 0 (entget en))) '("ATTRIB" "VERTEX" "SEQEND")))
   (ssadd en ss)
         ) ;if
      ) ;while
      (if (zerop (sslength ss))
         (setq ss nil)
      )
      ss
   ) ;progn
   (ssget "_x")
) ;if
  )
  ;;-------------
  (fun_setini)
  (if (setq $buchang (ureal 1 "" "\n增减值(正为增,负为减)" NBTV_TXT_CopyADD))
(setq NBTV_TXT_CopyADD $buchang)
  )
  (setq ss (ssget ))
  (setq e0 (entlast))
  (setq pt (getpoint "指定基点:"))
  (command "copy" ss "" pt pause)
  (setq loop T)
  (if (= 0 (distance (setq Point (getvar "LastPoint")) pt)) ;判断最后一点是不是pt点.
(progn (setq loop nil) ;Right Button
   (setq ent_tmp (LAST_ENT e0)) ;ent_tmp 是e0后生成的物体.
   (command "_.erase" ent_tmp "")
)
(setq pt Point)
  )
  (while loop
(SETQ SS1 (last_ent E0)
   I 0
)
(repeat (sslength ss1)
   (setq ent    (ssname ss1 i)
      i    (1+ i)
      entl (entget ent)
   ) ;图元资料
   (if (wcmatch (cdr (assoc 0 entl)) "*TEXT")
(progn (setq e-1 (cdr (assoc 1 entl))
      ;;文字内容
      NEWTX (Plus1 E-1 NBTV_TXT_CopyADD)
         )
         (entmod (subst (cons 1 NEWTX) (assoc 1 entl) entl)) ;更新文字
)
   )
) ;end repeat
(setq e0 (entlast))
(command "copy" ss1 "" pt pause)
(setq Point (getvar "LastPoint"))
(if (= 0 (distance Point pt)) ;判断最后一点是不是pt点.
   (progn (setq loop nil) ;Right Button
      (setq ent_tmp (LAST_ENT e0)) ;ent_tmp 是e0后生成的物体.
      (command "_.erase" ent_tmp "")
   )
   (progn (setq pt Point)
      ;;(setq ss (LAST_ENT e0))
   )
)
  )
  (fun_close)
  (princ)
)

(princ "复制文字增加数字 NBTC_TXTCopyadd")

偏爱云~小吴 · 发表于 2013-11-9 12:35

源码送上，如何增加字母递增，求高手指教

自贡黄明儒 · 发表于 2013-11-9 13:45

按你的要求,"3.2AB三4.5" 就是变成"4.3BC四5.6"了？

香田里浪人 · 发表于 2013-11-9 22:05

偏爱云~小吴发表于 2013-11-9 12:34
(defun c:zf (/ fun_setini fun_close fun_error FUN_GETdigit old_error old_DIMZIN ureal l ...

无法下载，不知何故？

香田里浪人 · 发表于 2013-11-11 17:41

香田里浪人发表于 2013-11-9 22:05
无法下载，不知何故？

谢谢，试了一下，可以用。

偏爱云~小吴 · 发表于 2013-11-14 22:41

论坛里的高手呢，高抬贵手啊帮帮菜鸟啊

xyp1964 · 发表于 2013-11-15 08:41

;;交代不清，没看到实例

偏爱云~小吴 · 发表于 2013-11-16 21:38

xyp1964 发表于 2013-11-15 08:41
;;交代不清，没看到实例

就是最后一位是数字的递增数字，是字母的递增字母，希望是递增复制而不是原位递增。想把字母和数字递增做一个整合版的。论坛里烦人多少原位递增的，不好用。谢谢了。

偏爱云~小吴 · 发表于 2013-11-16 21:39

xyp1964 发表于 2013-11-15 08:41
;;交代不清，没看到实例

你的这个貌似很强大的，我试试

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

[提问] 求一复制递增字母和数字的程序

相关帖子

本帖子中包含更多资源

点评

本帖子中包含更多资源