批改图框页码，选择集排序疑问

ㄘ丶转裑ㄧ灬 发表于 2018-7-19 20:53:05

本帖最后由ㄘ丶转裑ㄧ灬于 2018-7-19 20:57 编辑

各位好，附件为LXZ老师批改图框页码的源码，对于做幕墙施工画加工图来说作用很大，
但排序一直是个问题，只能麻烦些一排一排改，不然顺序会错乱。
试过拿各种排序源码去修改，奈何水平不足，一直达不到想要的效果，
所以只能发帖请教各位老师，希望有时间能指点下，谢谢！！

;;;;批量改图框页码
;by:LLXXZZ
;http://bbs.mjtd.com/thread-89140-1-1.html
;更改属性块标记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")
(if (vla-Get-HasAttributes blkref)
   (progn (setq liST0 (vlax-safearray->list(vlax-variant-value (vla-GetAttributes blkref))))
   (setq liST1 (mapcar 'vla-Get-TagStringliST0))
         (setq num (vl-position tag list1))
         (vla-put-TextString (nth num liST0) string)
)
); endif
); endif
(prin1)
); enddefun
;(setqent(car (entsel))) 例子
;(xz-att ent "页码" 30) 例子

;***********
(defun c:YM (/ 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(princ "\n必须选择属性块.")(exit)(princ))
         (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 2 0) ">:")))
(if (= strnil)(setq strstr0))

(initget "H V S ")(setq GETK (getkword "排序方式:\n [横向优先(H)/竖向优先(V)/选择优先(S)]: <H> "))
(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
;从左到右从上到下
((or (= GETK "H")(= GETK nil))
(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)))
(progn
(cond
   ((/= prefix "")
(if (=(strlen (rtos str))1)
   (setq sttr (strcat prefix "0" (rtos str 2 0)))
   (setq sttr (strcat prefix (rtos str 2 0)))
))
   ((= prefix "")(setq sttr(rtos str 2 0)))
);cond
(xz-att ent0 blktag sttr)
(princ (strcat " >>已修改至页:" (rtos str 2 0) "、"))
(setq len0 (1+ len0) str (1+ str))
(setq str0str)
)
   )
);repeat
(prin1)
)

xvjiex 发表于 2020-1-15 09:25:51

这应该是你要的。(princ "\n★功能：批量改图框页码，请输入 ym 命令。原著：by 李晓卓；修改：xvjiex\n")
(if (null vlax-dump-object) (vl-load-com) )
(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")
(if (vla-Get-HasAttributes blkref)
   (progn (setq liST0 (vlax-safearray->list(vlax-variant-value (vla-GetAttributes blkref))))
   (setq liST1 (mapcar 'vla-Get-TagStringliST0))
         (setq num (vl-position tag list1))
         (vla-put-TextString (nth num liST0) string)
)
); endif
); endif
(prin1)
); enddefun
;(setqent(car (entsel))) 例子
;(xz-att ent "页码" 30) 例子

;***********
(defun c:YM (/ EP1 EG1 EG2 blktag EP1st blkname str GETK prefix sttr
   index0 index sslist XZ_sortlist len0 len sslist_ptl )
(vl-load-com)
(if (progn
(setq EP1 (entsel "\n点取属性块中，页码的位置:"))
   (setq EG1 (cdr (assoc 0 (entget (car EP1)))))
      (if (/= EG1 "INSERT")
   (progn(princ "\n必须选择属性块.")(exit)(princ))
         (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 2 0) ">:")))
(if (= strnil)(setq strstr0))

(initget "H V S ")(setq GETK (getkword "排序方式:\n [横向优先(H)/竖向优先(V)/选择优先(S)]: <H> "))
(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 e_obj (vlax-ename->vla-object (entget (nth index0 sslist))))
(setq e_obj (vlax-ename->vla-object(nth index0 sslist)))
(vla-getboundingbox e_obj 'minpt 'maxpt)
(setq tmp_pt (cons (nth index0 sslist) (cons (vlax-safearray->listminpt) tmp_pt)))
(setq sslist_ptl (cons tmp_pt sslist_ptl))
(setq tmp_pt '())
(setq index0 (1+ index0))
)

;开始排序
(cond
;从左到右从上到下
((or (= GETK "H")(= GETK nil))
(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)))
(progn
(cond
   ((/= prefix "")
(if (=(strlen (rtos str))1)
   (setq sttr (strcat prefix "0" (rtos str 2 0) "页"))
   (setq sttr (strcat prefix (rtos str 2 0) "页"))
))
   ((= prefix "")(setq sttr(strcat (rtos str 2 0) "页")))
);cond
(xz-att ent0 blktag sttr)
(princ (strcat " >>已修改至页:" (rtos str 2 0) "、"))
(setq len0 (1+ len0) str (1+ str))
(setq str0str)
)
   )
);repeat
(prin1)
)

ㄘ丶转裑ㄧ灬 发表于 2018-7-20 08:47:57

死神去了发表于 2018-7-20 08:13
这个使用上完全没问题，排序是按照块的基点位置上下左右为判断依据的。。。
楼主的图框基点在横线位置就不 ...

是的，但公司的图框基本都在块的左下角，一旋转就难搞了，
属性块后期改基点又会把块里的属性移位，所以很烦~~！

死神去了 发表于 2018-7-20 08:13:43

本帖最后由死神去了于 2018-7-20 08:22 编辑

这个使用上完全没问题，排序是按照块的基点位置上下左右为判断依据的。。。
楼主的图框基点在横线位置就不会出错的

dong20030432 发表于 2018-7-20 11:35:49

用getboundingbox获取块图框的包围框，取左下角点进行排序试一下，应该可以。

852456 发表于 2018-8-11 19:48:24

看帖回帖是美德

kongel 发表于 2018-9-15 12:38:09

(setq tmp_pt (cons (nth index0 sslist) (cons (cdr(assoc 10 (entget (nth index0 sslist)))) tmp_pt)))

把这个改成

(setq tmp-pt (cons (nth index0 sslist) (cons (vlax-safearray->listminpoint) tmp-pt)))

涛涛_1048 发表于 2018-9-15 22:37:28

研究了半天，终于把选择优先放到前边了。有点笨了。

bai2000 发表于 2018-9-17 11:25:44

楼上的，把改后的东西传上来啊

依然小小鸟 发表于 2019-7-9 10:25:24

顶起来希望更多人解决

hn10183051 发表于 2019-9-25 10:55:42

改页码？怎么没有后缀页

页: [1] 2

明经CAD社区's Archiver

批改图框页码，选择集排序疑问