文本递增刷源码，我刷我刷我刷刷刷！(更新支持属性块)

CTC

不错，但没啥钱，老大施舍点钱我去下载用下

raimo

langjs  补零问题在论坛找了一段源码完美解决了，排序问题你上传图纸我看看

图纸没什么特别的，就是一个简单的单行文字，然后竖向往下复制n次，开了正交。
反复的使用命令dz， 框选的时候有时候从左往右，有时候从右往左

不过奇怪，今天回来再试的时候，没发现排序的问题了

ORCHI

好东西，搞电气的都知道，很方便，赞

xieyanghui

63楼这个能否再加上支持属性块呀，因为图框编号的时候很需要，谢谢！！！

raimo

langjs  补零问题在论坛找了一段源码完美解决了，

改完BUG的最新版啥时候能出呢？

xieyanghui

;;;页码任意修改

;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-TagString  liST0))   

      )

    ); endif

  ); endif

      (setq num (vl-position tag liSTt1))  ;;返回tag在list1中的排位位置

      (setq a (vla-get-TextString(nth num liST0))) ;;返回list0中第num个元素,取得该图元的textstring字符串

      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  EP1st blktag 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)

  ;开始增值

  (if (=  str1  nil) (setq str2 1))

  (setq str1 (getint (strcat "请输入增值<" (rtos str2) ">:")))

  (if (= str1  nil)(setq str1  str2))

    (setq len0 0 len (length sslist_ptl))

    (repeat len

                 (setq ent0 (car (nth len0 sslist_ptl)))  ;;返回第len0个图元的名称

                 (setq sttr (+ (atoi(xz-at ent0 blktag)) str1))

    (xz-att ent0 blktag sttr)

    (princ (strcat "-->增值 <" (rtos str1) ">  "))

    (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)

)

(princ "\n************************************************")

(princ "\n**    任意改页码 ympx.lsp已加载                 **")

(princ "\n**      >>任意改页码,以ympx启动命令             **")

(princ "\n**  ----by 李晓卓 modified by xiaxiang    **")

(princ "\n**                              2012.01.30    **")

(princ "\n************************************************")

(princ)
这个可以框选呀！！

hao3ren

使用了下框选程序，很不错，再支持下楼主的开源代码

aliao002007

很好的工具，先支持下，但没法下载~~~~

GamIng

一个个点太慢了，最好能支持批量操作。

xieyanghui

xieyanghui 发表于 2012-2-29 09:59
;;;页码任意修改

;1读取属性块标记tag所对应的值string

这是在明经里面看到的，不懂修改，只能用在属性文字，如果能和版主的结合就非常好用了！！