网上下载的页码任意排序源码，请高手完善
网上下载的页码任意排序源码，可实现属性块序号自动从小到大排列，但我想增加一个增值功能，即能是序号同加或同减一个数，如3、5、8同加1后得4、6、9，涂鸦了一下，未成功，请大侠修改一下。 怎么我的页码变为：DT-1.0000的样式了，我的原意页码应为： DT-01、DT-02。。。。。。。。。希望大神改改 xiaxiang 发表于 2012-1-30 08:21原作者是本论坛的LLXXZZ，请先注明。
代码我改了一下，传上来。
1. 第一个函数xz-at有问题，修改了一下
感谢分享源码，经测试使用没问题，但页码生成后会产生小数点4位数的0，如1.0000 2.0000 3.0000...
如若可以，还请帮忙修改，敝人感激～ xiaxiang 发表于 2012-1-30 08:21
原作者是本论坛的LLXXZZ，请先注明。
代码我改了一下，传上来。
1. 第一个函数xz-at有问题，修改了一下
能增加对动态块的选择吗？这个选不了动态块 本帖最后由 xiaxiang 于 2012-1-30 10:22 编辑
原作者是本论坛的LLXXZZ，请先注明。
代码我改了一下，传上来。
;;;页码任意修改
;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-TagStringliST0))
)
); 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-TagStringliST0)) ;;取得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 EG2EP1st 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 (=str0nil) (setq str0 1)) (initget 6)
(setq str (getint (strcat "请输入一个起始整数<" (rtos str0) ">:")))
(if (= strnil)(setq strstr0))
(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 0sslist_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 (=str1nil) (setq str2 1))
(setq str1 (getint (strcat "请输入增值<" (rtos str2) ">:")))
(if (= str1nil)(setq str1str2))
(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_sortlistsslist_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 str0str)
)
)
);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)1. 第一个函数xz-at有问题，修改了一下
2. 起始值和增值不应放在一起处理
3. 变量名中不应使用“-”，使用“_”要好一些
4. vla-Get-TagString和vla-Get-TextString的区别应理解一下
原创者 路过。。。
感谢使用。 LLXXZZ 发表于 2012-1-30 12:33 原创者 路过。。。 感谢使用。
希望老大小改一下：那个横向页码排序是从左到右，与y坐标的大小无关 哈哈，好铁需要多炼啊！只是我没火。 初学者，看不懂！悲催了！ 正是我所要的效果，xiaxiang大侠[em80解释的非常详细，非常专业，对xiaxiang大侠和原创LLXXZZ表示衷心的感谢和祝福，祝愿新年龙马精神，龙腾虎跃。 撒花 撒花~ 这程序写的真不错
页:
[1]
2