(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)
)
xvjiex 发表于 2020-1-15 09:25
这应该是你要的。
非常感谢！自己写了个图框程序，正愁如何自动化命名，刚好找到了这个帖子！ xvjiex 发表于 2020-1-15 09:25
这应该是你要的。
谢谢大佬正需要 xvjiex 发表于 2020-1-15 09:25
这应该是你要的。
大佬，强！！！！！！！！！！！
页:
1
[2]