明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 4282|回复: 17

网上下载的页码任意排序源码,请高手完善

  [复制链接]
发表于 2012-1-30 00:41 | 显示全部楼层 |阅读模式
网上下载的页码任意排序源码,可实现属性块序号自动从小到大排列,但我想增加一个增值功能,即能是序号同加或同减一个数,如3、5、8同加1后得4、6、9,涂鸦了一下,未成功,请大侠修改一下。

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2014-12-16 21:18 | 显示全部楼层
怎么我的页码变为:DT-1.0000的样式了,我的原意页码应为: DT-01、DT-02。。。。。。。。。希望大神改改
回复 支持 1 反对 0

使用道具 举报

发表于 2023-6-13 09:48 | 显示全部楼层
xiaxiang 发表于 2012-1-30 08:21
原作者是本论坛的LLXXZZ,请先注明。
代码我改了一下,传上来。
1. 第一个函数xz-at有问题,修改了一下

感谢分享源码,经测试使用没问题,但页码生成后会产生小数点4位数的0,如1.0000    2.0000   3.0000...
如若可以,还请帮忙修改,敝人感激~
发表于 2018-7-15 16:27 | 显示全部楼层
xiaxiang 发表于 2012-1-30 08:21
原作者是本论坛的LLXXZZ,请先注明。
代码我改了一下,传上来。
1. 第一个函数xz-at有问题,修改了一下

能增加对动态块的选择吗?这个选不了动态块
发表于 2012-1-30 08:21 | 显示全部楼层
本帖最后由 xiaxiang 于 2012-1-30 10:22 编辑

原作者是本论坛的LLXXZZ,请先注明。
代码我改了一下,传上来。

  1. ;;;页码任意修改
  2. ;1读取属性块标记tag所对应的值string
  3. (defun xz-at (ent tag / liST0 liSTt1 blkref a)
  4.   (vl-load-com)
  5.   (if (= (vla-Get-ObjectName (setq blkref (vlax-Ename->vla-Object ent))) "AcDbBlockReference")
  6.     (if (vla-Get-HasAttributes blkref)
  7.       (progn (setq liST0 (vlax-safearray->list  (vlax-variant-value (vla-GetAttributes blkref))))
  8.       (setq liSTt1 (mapcar 'vla-Get-TagString  liST0))   
  9.       )
  10.     ); endif
  11.   ); endif
  12.       (setq num (vl-position tag liSTt1))  ;;返回tag在list1中的排位位置
  13.       (setq a (vla-get-TextString(nth num liST0))) ;;返回list0中第num个元素,取得该图元的textstring字符串
  14.       a
  15. ); enddefun
  16. ;2更改属性块标记tag所对应的值string
  17. (defun xz-att (ent tag string / liST0 liST1 num blkref)
  18.   (vl-load-com) ;;加载扩展功能
  19.   (if (= (vla-Get-ObjectName (setq blkref (vlax-Ename->vla-Object ent))) "AcDbBlockReference") ;;将ent转为vla对象blref,取得名称,判断是否同后面一致
  20.     (if (vla-Get-HasAttributes blkref) ;;blkref块是否有属性
  21.       (progn (setq liST0 (vlax-safearray->list  (vlax-variant-value (vla-GetAttributes blkref)))) ;;取得块属性,返回值,属性值列表list0
  22.       (setq liST1 (mapcar 'vla-Get-TagString  liST0)) ;;取得list0每个标签字符串,赋给列表list1
  23.              (setq num (vl-position tag list1))  ;;返回tag在list1中的排位位置
  24.              (vla-put-TextString (nth num liST0) string) ;;返回list0中第num个元素,把string字符串赋给设定该图元
  25. )
  26.     ); endif
  27.   ); endif
  28.   (prin1)
  29. ); enddefun
  30. ;3主程序
  31. (defun c:ympx (/ EP1 EG1 EG2  EP1st blktag blkname str GETK prefix sttr
  32.       index0 index sslist XZ_sortlist len0 len sslist_ptl index0)
  33.   (vl-load-com)
  34.   (if (progn
  35.     (setq EP1 (entsel"点取属性块中页码的位置:\n"))
  36.            (setq EG1 (cdr (assoc 0 (entget (car EP1)))))
  37.            (if (= EG1 "INSERT")
  38.                (progn (setq EG2 (car (nentselp (cadr EP1))))
  39.                    (if (= (cdr (assoc 0 (entget EG2))) "ATTRIB")
  40.                 (setq blktag (cdr (assoc 2 (entget EG2)))) ;标记
  41.      )
  42.             (setq EP1st (entget (car EP1)))
  43.             (setq blkname (assoc 2 EP1st))   
  44.         )
  45.    )
  46.         )
  47.   (princ (strcat"  块名为-->" (cdr blkname) "   标记为-->" blktag "\n"))
  48.          (progn(princ "  必须选择属性块!")(exit))
  49.   )
  50.   ;开始选择页码块并修改
  51.   (setq prefix (getstring "请输入前缀:"))
  52.   (if (=  str0  nil) (setq str0 1)) (initget 6)
  53.   (setq str (getint (strcat "请输入一个起始整数<" (rtos str0) ">:")))
  54.   (if (= str  nil)(setq str  str0))
  55.   (initget "H V S ")(setq GETK (getkword "排序方式:\n [数值增加(回车)/横向优先(H)/竖向优先(V)/选择优先(S)]: <回车> "))
  56.   (princ ">>选择批量修改页码的对象...")
  57.   (setq ss (ssget  (cons blkname slist)))
  58.   (setq index0 0 index (sslength ss) sslist '())  
  59.   (repeat index
  60.     (setq sslist (cons (ssname ss index0) sslist))
  61.     (setq index0 (1+ index0))
  62.   )
  63.   ;开始构建图元点位表
  64.   (setq index0 0  sslist_ptl '() tmp-pt '())  
  65.   (repeat index
  66.     (setq tmp-pt (cons (nth index0 sslist) (cons (cdr(assoc 10 (entget (nth index0 sslist)))) tmp-pt)))
  67.     (setq sslist_ptl (cons tmp-pt sslist_ptl))
  68.     (setq tmp-pt '())
  69.     (setq index0 (1+ index0))
  70.   )
  71.   ;开始排序
  72.   (cond      
  73.   ((= GETK nil)
  74.   ;开始增值
  75.   (if (=  str1  nil) (setq str2 1))
  76.   (setq str1 (getint (strcat "请输入增值<" (rtos str2) ">:")))
  77.   (if (= str1  nil)(setq str1  str2))
  78.     (setq len0 0 len (length sslist_ptl))
  79.     (repeat len
  80.                  (setq ent0 (car (nth len0 sslist_ptl)))  ;;返回第len0个图元的名称
  81.                  (setq sttr (+ (atoi(xz-at ent0 blktag)) str1))
  82.     (xz-att ent0 blktag sttr)
  83.     (princ (strcat "-->增值 <" (rtos str1) ">  "))
  84.     (setq len0 (1+ len0))  
  85.       );repeat
  86.   )
  87.   ;从左到右从上到下
  88.   ((= GETK "H")
  89.     (setq XZ_sortlist (vl-sort
  90.    (vl-sort sslist_ptl '(lambda (s1 s2) (> (cadadr s1) (cadadr s2))))
  91.    '(lambda (s3 s4) (if(equal (cadadr s3) (cadadr s4) 0.6)(< (caadr s3) (caadr s4))))))   
  92.   )
  93.   ;从上到下从左到右
  94.   ((= GETK "V")
  95.     (setq XZ_sortlist (vl-sort
  96.    (vl-sort sslist_ptl '(lambda (s1 s2) (< (caadr s1) (caadr s2))))
  97.    '(lambda (s3 s4) (if(equal (caadr s3) (caadr s4) 0.6)(> (cadadr s3) (cadadr s4))))))   
  98.    )
  99.    ;选择顺序
  100.   ((= GETK "S")
  101.     (setq XZ_sortlist  sslist_ptl))
  102.    );cond
  103.   ;开始修改页码
  104.     (setq len0 0 len (length XZ_sortlist))
  105.     (repeat len
  106.      (if (setq ent0 (car (nth len0 XZ_sortlist)))  ;;返回第len0个图元的名称
  107.   (progn
  108.     (cond
  109.       ((/= prefix "")
  110.     (if (=(strlen (rtos str))1)
  111.       (setq sttr (strcat prefix "0" (rtos str)))
  112.       (setq sttr (strcat prefix (rtos str)))
  113.     ))
  114.       ((= prefix "")(setq sttr  (rtos str)))
  115.     );cond
  116.     (xz-att ent0 blktag sttr)
  117.     (princ (strcat "-->修码 <" (rtos str) ">  "))
  118.     (setq len0 (1+ len0) str (1+ str))
  119.     (setq str0  str)         
  120.   )
  121.       )
  122.   );repeat
  123.   (prin1)
  124. )
  125. (princ "\n************************************************")
  126. (princ "\n**    任意改页码 ympx.lsp已加载                 **")
  127. (princ "\n**      >>任意改页码,以ympx启动命令             **")
  128. (princ "\n**  ----by 李晓卓 modified by xiaxiang    **")
  129. (princ "\n**                              2012.01.30    **")
  130. (princ "\n************************************************")
  131. (princ)
1. 第一个函数xz-at有问题,修改了一下
2. 起始值和增值不应放在一起处理
3. 变量名中不应使用“-”,使用“_”要好一些
4. vla-Get-TagString和vla-Get-TextString的区别应理解一下
发表于 2012-1-30 12:33 | 显示全部楼层
原创者 路过。。。
感谢使用。
发表于 2012-1-30 13:37 来自手机 | 显示全部楼层
LLXXZZ 发表于 2012-1-30 12:33 原创者 路过。。。 感谢使用。

希望老大小改一下:那个横向页码排序是从左到右,与y坐标的大小无关
发表于 2012-1-30 14:59 | 显示全部楼层
哈哈,好铁需要多炼啊!只是我没火。
发表于 2012-1-30 15:23 | 显示全部楼层
初学者,看不懂!悲催了!
 楼主| 发表于 2012-1-30 18:21 | 显示全部楼层
正是我所要的效果,xiaxiang大侠[em80解释的非常详细,非常专业,对xiaxiang大侠和原创LLXXZZ表示衷心的感谢和祝福,祝愿新年龙马精神,龙腾虎跃。
发表于 2012-1-30 22:49 | 显示全部楼层
发表于 2012-2-1 15:30 | 显示全部楼层
撒花 撒花~
发表于 2012-2-2 13:31 | 显示全部楼层
这程序写的真不错
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 14:55 , Processed in 0.290536 second(s), 32 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表