求助自动数字递增

cj52000 · 发表于 2010-5-17 09:53:00

xshrimp兄，能否帮忙改下如下形式的递增，
ABC-50-123
ABC-50-123-131
ABC-50-123-131-123212
其中123数字为递增，也就是第三组数字递增，谢谢！

明经网友 *发表于 2010-5-17 11:02:00* · 发表于 2010-5-17 11:02:00

(defun c:bhao (/   var1      basetext selflag    tabnum enttext enttext0
        basevbatext      bgf bgL    valuea
        valueb   enttexta   seltexta enttexta0 prefix suffix fixnumstr i fixnum prefixflag fixflag
        basetexta fixnumlength
       )
(setq var1 (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq enttext
(entget
    (setq seltext (car (entsel "选择基数\n")))
)
)
(setq enttext0 (cdr (assoc 0 enttext)))
(setq basetext (cond
     ((= "TEXT" enttext0)
      (cdr (assoc 1 enttext))
     )
     ((= "INSERT" enttext0)
      (cdr (assoc 1 (entget (entnext seltext))))
     )
     (t 1)
   )
)
(setq selflag 1
tabnum 1
)

(setq fixnumstr "0123456789")
(setq prefix "");;正确判断经下三组数据
(setq fixnum "")
(setq suffix "")
(setq i 0)

(while (not (wcmatch fixnumstr (strcat "*" (chr (vl-string-elt basetext i)) "*")))
    (setq prefix (strcat prefix (chr (vl-string-elt basetext i))))
    (setq i (1+ i)))

(setq basetexta (vl-string-left-trim prefix basetext))

(setq i 0)
(setq fixflag 1)
;;; (princ "IT'S OK1!")
(while fixflag
    (if (wcmatch fixnumstr
   (strcat "*" (chr (vl-string-elt basetexta i)) "*")
)
      (setq fixnum (strcat fixnum (chr (vl-string-elt basetexta i))))
    )
    (setq i (1+ i))
    (if (= i (strlen basetexta))
      (setq fixflag nil)
    )
)
;;;(princ "IT'S OK!")
(setq suffix (vl-string-left-trim fixnum basetexta))
(setq valueb fixnum)
(setq fixnumlength (strlen fixnum))
;;;(princ "IT'S OK1!")
(while (= 1 selflag)
    (princ "本次编号：")
    (setq valueb (atoi valueb))
    (princ valueb)
    (setq valueb (+ tabnum valueb))
    (setq valueb (itoa valueb))
    (while (<(strlen valueb) fixnumlength)
      (setq valueb (strcat "0" valueb)))
         (setq basetext (strcat prefix valueb suffix))


    (setq seltexta (entsel "选择要修改的编号\n"))

    (if seltexta
      (setq enttexta (entget (car seltexta)))
      (setq selflag nil)
    )
    (if selflag
      (progn
(setq enttexta0 (cdr (assoc 0 enttexta)))
(setq enttexta
        (cond
   ((= "TEXT" enttexta0)
    (subst (cons 1 basetext)
    (assoc 1 enttexta)
    enttexta
    )
   )
   ((= "INSERT" enttexta0)
    (subst (cons 1 basetext)
    (assoc 1 (entget (entnext (car seltexta))))
    (entget (entnext (car seltexta)))
    )
   )
   (t 1)
        )
)
(entmod enttexta)
(entupd (car seltexta))
      )
    )     ;end while entcn
)
(princ)
)

xiguao · 发表于 2010-5-17 11:31:00

(defun c:bhao (/   var1      basetext selflag    tabnum enttext enttext0
        basevbatext      bgf bgL    valuea
        valueb   enttexta   seltexta enttexta0 prefix suffix fixnumstr i fixnum prefixflag fixflag
        basetexta fixnumlength
       )
(setq var1 (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq enttext
(entget
    (setq seltext (car (entsel "选择基数\n")))
)
)
(setq enttext0 (cdr (assoc 0 enttext)))
(setq basetext (cond
     ((= "TEXT" enttext0)
      (cdr (assoc 1 enttext))
     )
     ((= "INSERT" enttext0)
      (cdr (assoc 1 (entget (entnext seltext))))
     )
     (t 1)
   )
)
(setq selflag 1
tabnum 1
)

(setq fixnumstr "0123456789")
(setq prefix "");正确判断以下三个数据
(setq fixnum "")
(setq suffix "")
(setq i 0)

(while (not (wcmatch fixnumstr (strcat "*" (chr (vl-string-elt basetext i)) "*")))
    (setq prefix (strcat prefix (chr (vl-string-elt basetext i))))
    (setq i (1+ i)))

(setq basetexta (vl-string-left-trim prefix basetext))

(setq i 0)
(setq fixflag 1)
;;; (princ "IT'S OK1!")
(while fixflag
    (if (wcmatch fixnumstr
   (strcat "*" (chr (vl-string-elt basetexta i)) "*")
)
      (setq fixnum (strcat fixnum (chr (vl-string-elt basetexta i))))
    )
    (setq i (1+ i))
    (if (= i (strlen basetexta))
      (setq fixflag nil)
    )
)
;;;(princ "IT'S OK!")
(setq suffix (vl-string-left-trim fixnum basetexta))
(setq valueb fixnum)
(setq fixnumlength (strlen fixnum))
;;;(princ "IT'S OK1!")
(while (= 1 selflag)
    (princ "本次编号：")
    (setq valueb (atoi valueb))
    (princ valueb)
    (setq valueb (+ tabnum valueb))
    (setq valueb (itoa valueb))
    (while (<(strlen valueb) fixnumlength)
      (setq valueb (strcat "0" valueb)))
         (setq basetext (strcat prefix valueb suffix))


    (setq seltexta (entsel "选择要修改的编号\n"))

    (if seltexta
      (setq enttexta (entget (car seltexta)))
      (setq selflag nil)
    )
    (if selflag
      (progn
(setq enttexta0 (cdr (assoc 0 enttexta)))
(setq enttexta
        (cond
   ((= "TEXT" enttexta0)
    (subst (cons 1 basetext)
    (assoc 1 enttexta)
    enttexta
    )
   )
   ((= "INSERT" enttexta0)
    (subst (cons 1 basetext)
    (assoc 1 (entget (entnext (car seltexta))))
    (entget (entnext (car seltexta)))
    )
   )
   (t 1)
        )
)
(entmod enttexta)
(entupd (car seltexta))
      )
    )     ;end while entcn
)
(princ)
)

cj52000 · 发表于 2010-5-17 15:30:00

谢谢楼上的热心，好像达不到我想要的效果！

cj52000 · 发表于 2010-5-18 14:53:00

各位，能否帮忙改下如下形式的递增，
ABC-50-123
ABC-50-123-131
ABC-50-123-131-123212
其中123数字为递增，也就是第三组数字递增，谢谢！

xshrimp · 发表于 2010-5-18 16:42:00

楼主自己修改一下就可以了啊.
适合
ABC-50-123
ABC-50-123-131
ABC-50-123-131-123212
其中123数字为递增

(defun c:test ()
(setq i (getint "\输入起始数字:"))
(while (setq txt (ssget ":S" '((0 . "TEXT"))))
(setq txt (ssname txt 0) dat (entget txt) str (cdr (assoc 1 dat)) )
;(setq str "ABC-001-50-2A2") ;test
(setq strlst (strParse Str "-"))
(setq numws (strlen (nth 2 strlst)))
(setq txt_num_new (itoa i ))
(repeat (- numws (strlen txt_num_new))
(setq txt_num_new (strcat "0" txt_num_new))
)
(setq nuwstr (StrUnParse (append (list (car strlst))(list (cadr strlst))(list txt_num_new) (cdddr strlst)) "-"))
(entmod (subst (cons 1 nuwstr ) (assoc 1 dat) Dat ) )
(setq i (1+ i))
)
)

cj52000 · 发表于 2010-5-19 11:18:00

谢谢xshrimp兄的关注，程序正是我想要的，但是有一个疑问，我对比了一下你之前的程序，只有一处是不一样的，就是这句“(nth 2 strlst)))”中的数字不一样，你之前的程序数字是1，递增的是第二组数字，你给我改的程序数字是2，递增的是第三组数字，我把程序中的数改成3，试了一下发现第四组数字并没有递增，递增的仍然是第三组数字，我想说的是改哪个地方，可以自由更改，来满足不同组的递增，谢谢！

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