CFDW批量提取设计图纸属性图框中单图号到剪贴板

xyp1964

寒潮大冬瓜 发表于 2025-7-10 11:37
院长出马必为杰作！

1. (defun c:tt ()
   
2.   "图名图号"
   
3.   (xyp-Start)
   
4.   (xyp-Ctbl (/ 30 3.))
   
5.   (if (and (setq qf '((0 . "insert") (66 . 1) (2 . "广东深圳2018-乙-S-A0-1")))
   
6.            (setq ss (ssget qf))
   
7.            (setq p0 (getpoint "\n表格基点<退出>: "))
   
8.       )
   
9.     (setq lst (mapcar '(lambda (x)(vl-remove-if-not'(lambda (y) (member (cadr y) '("图纸名称" "图号")))x))(mapcar 'xyp-att2list (xyp-Ss2List ss))           )
   
10.           lst (mapcar '(lambda (x) (mapcar 'last x)) lst)
    
11.           lst (vl-sort lst '(lambda (x y) (< (cadr x) (cadr y))))
    
12.           aa  (xyp-TableAuto p0 lst '("序号" "图名" "图号"))
    
13.     )
    
14.   )
    
15.   (xyp-End)
    
16. )

(defun c:tt ()<br />   "图名图号"<br />   (xyp-Start)<br />   (xyp-Ctbl (/ 30 3.))<br />   (if (and (setq qf '((0 . "insert") (66 . 1) (2 . "广东深圳2018-乙-S-A0-1")))<br />            (setq ss (ssget qf))<br />            (setq p0 (getpoint "\n表格基点<退出>: "))<br />       )<br />     (setq lst (mapcar '(lambda (x)(vl-remove-if-not'(lambda (y) (member (cadr y) '("图纸名称" "图号")))x))(mapcar 'xyp-att2list (xyp-Ss2List ss))           )<br />           lst (mapcar '(lambda (x) (mapcar 'last x)) lst)<br />           lst (vl-sort lst '(lambda (x y) (< (cadr x) (cadr y))))<br />           aa  (xyp-TableAuto p0 lst '("序号" "图名" "图号"))<br />     )<br />   )<br />   (xyp-End)<br /> )

寒潮大冬瓜

xyp1964 发表于 2025-7-10 12:20

很好→很棒！很好~很棒！！很好……很棒！！！