求一个改页码的程序

皇上快溜

页码格式 XX / XX  ，前缀为页码 ，后缀为页码总数 。属性块字符 。先点选某图框的页码字符 XX / XX  ，然后框选全图，求出图框总数，并修改所有图框页码字符 XX / XX  的后缀。然后人工逐个点选，逐个修改前缀，，，

皇上快溜

本程序来自明经，想请各位帮忙改改，将 (setq prefix (getstring "请输入前缀:"))改为后缀，/xx格式，谢谢大家

(defun xz-at (ent tag / liST0 liSTt1 blkref a)
  (vl-load-com)
  (if (= (vla-Get-ObjectName (setq blkref (vlax-Ename->vla-Object ent))) "AcDbBlockReference")
    (if (vla-Get-HasAttributes blkref)
      (progn (setq liST0 (vlax-safearray->list  (vlax-variant-value (vla-GetAttributes blkref))))
      (setq liSTt1 (mapcar 'vla-Get-TextString  liST0))   
      )
    ); endif
  ); endif
      (setq num (vl-position tag list1))  ;;返回tag在list1中的排位位置
      (setq a (nth num llist1)) ;;返回list0中第num个元素,把string字符串赋给设定该图元
      a
); enddefun
;2更改属性块标记tag所对应的值string
(defun xz-att (ent tag string / liST0 liST1 num blkref)
  (vl-load-com) ;;加载扩展功能
  (if (= (vla-Get-ObjectName (setq blkref (vlax-Ename->vla-Object ent))) "AcDbBlockReference") ;;将ent转为vla对象blref,取得名称,判断是否同后面一致
    (if (vla-Get-HasAttributes blkref) ;;blkref块是否有属性
      (progn (setq liST0 (vlax-safearray->list  (vlax-variant-value (vla-GetAttributes blkref)))) ;;取得块属性,返回值,属性值列表list0
      (setq liST1 (mapcar 'vla-Get-TagString  liST0)) ;;取得list0每个标签字符串,赋给列表list1
             (setq num (vl-position tag list1))  ;;返回tag在list1中的排位位置
             (vla-put-TextString (nth num liST0) string) ;;返回list0中第num个元素,把string字符串赋给设定该图元
)
    ); endif
  ); endif
  (prin1)
); enddefun
;3主程序
(defun c:ympx (/ EP1 EG1 EG2 blktag EP1st blkname str GETK prefix sttr
      index0 index sslist XZ_sortlist len0 len sslist-ptl index0)
  (vl-load-com)
  (if (progn
    (setq EP1 (entsel"点取属性块中页码的位置:\n"))
           (setq EG1 (cdr (assoc 0 (entget (car EP1)))))
           (if (= EG1 "INSERT")
               (progn (setq EG2 (car (nentselp (cadr EP1))))
                   (if (= (cdr (assoc 0 (entget EG2))) "ATTRIB")
                (setq blktag (cdr (assoc 2 (entget EG2)))) ;标记
     )
            (setq EP1st (entget (car EP1)))
            (setq blkname (assoc 2 EP1st))   
        )
   )
        )
  (princ (strcat"  块名为-->" (cdr blkname) "   标记为-->" blktag "\n"))
         (progn(princ "  必须选择属性块!")(exit))
  )
  ;开始选择页码块并修改
  (setq prefix (getstring "请输入前缀:"))
  (if (=  str0  nil) (setq str0 1)) (initget 6)
  (setq str (getint (strcat "请输入增值或序号起整数<" (rtos str0) ">:")))
  (if (= str  nil)(setq str  str0))
  (initget "H V S ")(setq GETK (getkword "排序方式:\n [数值增加(回车)/横向优先(H)/竖向优先(V)/选择优先(S)]: <回车> "))
  (princ ">>选择批量修改页码的对象...")
  (setq ss (ssget  (cons blkname slist)))
  (setq index0 0 index (sslength ss) sslist '())  
  (repeat index
    (setq sslist (cons (ssname ss index0) sslist))
    (setq index0 (1+ index0))
  )
  ;开始构建图元点位表
  (setq index0 0  sslist-ptl '() tmp-pt '())  
  (repeat index
    (setq tmp-pt (cons (nth index0 sslist) (cons (cdr(assoc 10 (entget (nth index0 sslist)))) tmp-pt)))
    (setq sslist-ptl (cons tmp-pt sslist-ptl))
    (setq tmp-pt '())
    (setq index0 (1+ index0))
  )
  ;开始排序
  (cond      
   ((= GETK nil)
  ;开始增值
    (setq len0 0 len (length sslist-ptl))
    (repeat len
                 (setq ent0 (car (nth len0 sslist-ptl)))  ;;返回第len0个图元的名称
                 (setq old (xz-at ent0 blktag))
(princ "\n测试中。。。 ")
                 (setq num (atoi (cdr (assoc 1 old))))
                 (setq sttr (itoa (+ num str)))
    (xz-att ent0 blktag sttr)
    (princ (strcat "-->增值 <" (rtos str) ">  "))
    (setq len0 (1+ len0))  
      );repeat
  )
  ;从左到右从上到下
  ((= GETK "H")
    (setq XZ_sortlist (vl-sort
   (vl-sort sslist-ptl '(lambda (s1 s2) (> (cadadr s1) (cadadr s2))))
   '(lambda (s3 s4) (if(equal (cadadr s3) (cadadr s4) 0.6)(< (caadr s3) (caadr s4))))))   
  )
  ;从上到下从左到右
  ((= GETK "V")
    (setq XZ_sortlist (vl-sort
   (vl-sort sslist-ptl '(lambda (s1 s2) (< (caadr s1) (caadr s2))))
   '(lambda (s3 s4) (if(equal (caadr s3) (caadr s4) 0.6)(> (cadadr s3) (cadadr s4))))))   
   )
   ;选择顺序
  ((= GETK "S")
    (setq XZ_sortlist  sslist-ptl))
   );cond
  ;开始修改页码
    (setq len0 0 len (length XZ_sortlist))
    (repeat len
     (if (setq ent0 (car (nth len0 XZ_sortlist)))  ;;返回第len0个图元的名称
  (progn
    (cond
      ((/= prefix "")
    (if (=(strlen (rtos str))1)
      (setq sttr (strcat prefix "0" (rtos str)))
      (setq sttr (strcat prefix (rtos str)))
    ))
      ((= prefix "")(setq sttr  (rtos str)))
    );cond
    (xz-att ent0 blktag sttr)
    (princ (strcat "-->修码 <" (rtos str) ">  "))
    (setq len0 (1+ len0) str (1+ str))
    (setq str0  str)         
  )
      )
  );repeat
  (prin1)
)

hn10183051

;;;页码任意修改
;1读取属性块标记tag所对应的值string
(defun xz-at (ent tag / liST0 liSTt1 blkref a)
  (vl-load-com)
  (if (= (vla-Get-ObjectName (setq blkref (vlax-Ename->vla-Object ent))) "AcDbBlockReference")
    (if (vla-Get-HasAttributes blkref)
      (progn (setq liST0 (vlax-safearray->list  (vlax-variant-value (vla-GetAttributes blkref))))
             (setq liSTt1 (mapcar 'vla-Get-TextString  liST0))   
      )
    ); endif
  ); endif
      (setq num (vl-position tag list1))  ;;返回tag在list1中的排位位置
      (setq a (nth num llist1)) ;;返回list0中第num个元素,把string字符串赋给设定该图元
      a
); enddefun

;2更改属性块标记tag所对应的值string
(defun xz-att (ent tag string / liST0 liST1 num blkref)
  (vl-load-com) ;;加载扩展功能
  (if (= (vla-Get-ObjectName (setq blkref (vlax-Ename->vla-Object ent))) "AcDbBlockReference") ;;将ent转为vla对象blref,取得名称,判断是否同后面一致
    (if (vla-Get-HasAttributes blkref) ;;blkref块是否有属性
      (progn (setq liST0 (vlax-safearray->list  (vlax-variant-value (vla-GetAttributes blkref)))) ;;取得块属性,返回值,属性值列表list0
             (setq liST1 (mapcar 'vla-Get-TagString  liST0)) ;;取得list0每个标签字符串,赋给列表list1
             (setq num (vl-position tag list1))  ;;返回tag在list1中的排位位置
             (vla-put-TextString (nth num liST0) string) ;;返回list0中第num个元素,把string字符串赋给设定该图元
        )
    ); endif
  ); endif
  (prin1)
); enddefun

;3主程序
(defun c:qq1 (/ EP1 EG1 EG2 blktag EP1st blkname str GETK prefix sttr
             index0 index sslist XZ_sortlist len0 len sslist-ptl index0)
  (vl-load-com)
  (if (progn
           (setq EP1 (entsel"点取属性块中页码的位置:\n"))
           (setq EG1 (cdr (assoc 0 (entget (car EP1)))))
           (if (= EG1 "INSERT")
               (progn (setq EG2 (car (nentselp (cadr EP1))))
                   (if (= (cdr (assoc 0 (entget EG2))) "ATTRIB")
                       (setq blktag (cdr (assoc 2 (entget EG2)))) ;标记
                   )
                   (setq EP1st (entget (car EP1)))
                   (setq blkname (assoc 2 EP1st))   
               )
          )
        )
         (princ (strcat"  块名为-->" (cdr blkname) "   标记为-->" blktag "\n"))
         (progn(princ "  必须选择属性块!")(exit))
         )
  ;开始选择页码块并修改
  (if (=  str0  nil) (setq str0 1)) (initget 6)
  (setq mstr (getint "\n总页数<100>："))
  (setq str (getint (strcat "请输入增值或序号起整数<" (rtos str0) ">:")))
  (if (= str  nil)(setq str  str0))
   (if (not mstr) (setq mstr 100))
  (initget "H V S ")(setq GETK (getkword "排序方式:\n [横向优先(H)/竖向优先(V)/选择优先(S)]: <V> "))
  (if (not GETK) (setq GETK "V"))
  (princ ">>选择批量修改页码的对象...")
  (setq ss (ssget  (cons blkname slist)))
  (setq index0 0 index (sslength ss) sslist '())         
  (repeat index
    (setq sslist (cons (ssname ss index0) sslist))
    (setq index0 (1+ index0))
  )
  ;开始构建图元点位表
  (setq index0 0  sslist-ptl '() tmp-pt '())         
  (repeat index
    (setq tmp-pt (cons (nth index0 sslist) (cons (cdr(assoc 10 (entget (nth index0 sslist)))) tmp-pt)))
    (setq sslist-ptl (cons tmp-pt sslist-ptl))
    (setq tmp-pt '())
    (setq index0 (1+ index0))
  )
  ;开始排序
  (cond      
   ((= GETK nil)
  ;开始增值
    (setq len0 0 len (length sslist-ptl))

    (repeat len
                 (setq ent0 (car (nth len0 sslist-ptl)))  ;;返回第len0个图元的名称
                 (setq old (xz-at ent0 blktag))
(princ "\n测试中。。。 ")
                 (setq num (atoi (cdr (assoc 1 old))))
                 (setq sttr (itoa (+ num str)))
           (xz-att ent0 blktag sttr)
           (princ (strcat "-->增值 <" (rtos str) ">  "))
           (setq len0 (1+ len0))  
      );repeat
  )

  ;从左到右从上到下
  ((= GETK "H")
    (setq XZ_sortlist (vl-sort
                        (vl-sort sslist-ptl '(lambda (s1 s2) (> (cadadr s1) (cadadr s2))))
                        '(lambda (s3 s4) (if(equal (cadadr s3) (cadadr s4) 0.6)(< (caadr s3) (caadr s4))))))   
  )
  ;从上到下从左到右
  ((= GETK "V")
    (setq XZ_sortlist (vl-sort
                        (vl-sort sslist-ptl '(lambda (s1 s2) (< (caadr s1) (caadr s2))))
                        '(lambda (s3 s4) (if(equal (caadr s3) (caadr s4) 0.6)(> (cadadr s3) (cadadr s4))))))   
   )
   ;选择顺序
  ((= GETK "S")
    (setq XZ_sortlist  sslist-ptl))
   );cond
  ;开始修改页码
    (setq len0 0 len (length XZ_sortlist))
    (repeat len
     (if (setq ent0 (car (nth len0 XZ_sortlist)))  ;;返回第len0个图元的名称
         (progn
           (cond
             ((/= prefix "")
           (if (=(strlen (rtos str))1)
             (setq sttr (strcat "共 " (itoa mstr) " 页/第 " (itoa str) " 页"))
             (setq sttr (strcat "共 " (itoa mstr) " 页/第 " (itoa str) " 页"))
             
           ))
             ((= prefix "")(setq sttr  (rtos str)))
           );cond
           (xz-att ent0 blktag sttr)
           (princ (strcat "-->修码 <" (rtos str) ">  "))
           (setq len0 (1+ len0) str (1+ str))
           (setq str0  str)                 
         )
      )
  );repeat
  (prin1)
)