目录生成器，求完善

KO你

gaics大师的现在是以图号大小排序，目录生成保存在C盘，两个文件。
请高手完善：
1、目录从左到右，从上到上排序。
2、取消  (setq apnt (getpoint "\n选择目录放置点："))这一步
3、生成的目录.txt文件保存在CAD文件的文件夹位置，只生成目录一个.txt文件。

gaics

从左到右、从上到下跟图框的基点、对齐方式有很大关系。

2. (defun c:mm (/              blkname  nametag        numtag         ss          sslist
   
3.              file     index0   index        tmp_pt         XZ_sortlist
   
4.              s1              s2       s3        s4         lst0          lst
   
5.              i              tk       sslist_ptl         path          drawingname
   
6.             )
   
7.   (setvar "cmdecho" 0)
   
8.   (setvar "filedia" 0)
   
9.   (princ "\n第1步：请选择“图名”属性字...")
   
10.   (setq nametag (choose_att))
    
11.   (setq blkname (cdr nametag))
    
12.   (setq nametag (car nametag))
    
13.   (princ "\n第2步：请选择“图号”属性字...")
    
14.   (setq numtag (choose_att))
    
15.   (setq numtag (car numtag))
    
16.   (princ "\n第3步：请选择需要生成目录的对象...")
    
17.   (setq ss (ssget (list '(0 . "insert") (cons 2 blkname))))
    
18.   (setq        index0 0
    
19.         index  (sslength ss)
    
20.         sslist '()
    
21.   )
    
22.   (repeat index
    
23.     (setq sslist (cons (ssname ss index0) sslist))
    
24.     (setq index0 (1+ index0))
    
25.   )
    
26.   ;;开始构建图元点位表
    
27.   (setq        index0 0
    
28.         sslist_ptl
    
29.          '()
    
30.         tmp_pt '()
    
31.   )
    
32.   (repeat index
    
33.     (setq tmp_pt
    
34.            (cons
    
35.              (nth index0 sslist)
    
36.              (cons (cdr (assoc 10 (entget (nth index0 sslist)))) tmp_pt)
    
37.            )
    
38.     )
    
39.     (setq sslist_ptl (cons tmp_pt sslist_ptl))
    
40.     (setq tmp_pt '())
    
41.     (setq index0 (1+ index0))
    
42.   )
    
43.   ;;开始排序
    
44.   ;;从左到右从上到下
    
45.   (setq        XZ_sortlist
    
46.          (vl-sort
    
47.            (vl-sort sslist_ptl
    
48.                     '(lambda (s1 s2) (> (cadadr s1) (cadadr s2)))
    
49.            )
    
50.            '(lambda (s3 s4)
    
51.               (if (equal (cadadr s3) (cadadr s4) 300)
    
52.                 (< (caadr s3) (caadr s4))
    
53.               )
    
54.             )
    
55.          )
    
56.   )
    
57.   (setq i 0)
    
58.   (setq lst '())
    
59.   (setq lst0 '())
    
60.   (while (< i (length XZ_sortlist))
    
61.     (setq tk (car (nth i XZ_sortlist)))
    
62.     (get_att)
    
63.     (setq name (cdr (assoc nametag shuxing)))
    
64.     (setq num (cdr (assoc numtag shuxing)))
    
65.     (setq lst0 (list name num))
    
66.     (setq lst (cons lst0 lst))
    
67.     (setq i (+ i 1))
    
68.   )
    
69.   (setq lst (reverse lst))
    
70.   (setq path (getvar 'DWGPREFIX))
    
71.   (setq drawingname (vl-filename-base (getvar 'DWGNAME)))
    
72.   (setq file (open (strcat path drawingname "图纸目录.txt") "w"))
    
73.   (setq i 0)
    
74.   (while (< i (length lst))
    
75.     (write-line
    
76.       (strcat (car (nth i lst)) " " (cadr (nth i lst)))
    
77.       file
    
78.     )
    
79.     (setq i (+ i 1))
    
80.   )
    
81.   (close file)
    
82.   (setvar "filedia" 1)
    
83.   (princ)
    
84. )
    
85. 
    
86. 
    
87. (defun get_att ()
    
88.   (setq obj (vlax-ename->vla-object tk))
    
89.   (setq        shuxing
    
90.          (mapcar '(lambda (att)
    
91.                     (cons (vla-get-TagString att) (vla-get-TextString att))
    
92.                   )
    
93.                  (vlax-invoke obj "GetAttributes")
    
94.          )
    
95.   )
    
96. )
    
97. 
    
98. (defun choose_att (/ a b)
    
99.   (if (setq a (entsel))
    
100.     (progn (setq b (car (nentselp (cadr a)))) ;图元名
     
101.            (if (/= (cdr (assoc 0 (entget b))) "ATTRIB") ;图元属性
     
102.              (progn (alert "******必须选择属性字!******")
     
103.                     (choose_att)
     
104.              )
     
105.              (cons (cdr (assoc 2 (entget b)))
     
106.                    (cdr (assoc 2 (entget (car a))))
     
107.              )
     
108.            )
     
109.     )
     
110.     (progn (alert "******必须选择属性字!******")
     
111.            (choose_att)
     
112.     )
     
113.   )
     
114. )

(defun c:mm (/              blkname  nametag        numtag         ss          sslist<br />              file     index0   index        tmp_pt         XZ_sortlist<br />              s1              s2       s3        s4         lst0          lst<br />              i              tk       sslist_ptl         path          drawingname<br />             )<br />   (setvar "cmdecho" 0)<br />   (setvar "filedia" 0)<br />   (princ "\n第1步：请选择“图名”属性字...")<br />   (setq nametag (choose_att))<br />   (setq blkname (cdr nametag))<br />   (setq nametag (car nametag))<br />   (princ "\n第2步：请选择“图号”属性字...")<br />   (setq numtag (choose_att))<br />   (setq numtag (car numtag))<br />   (princ "\n第3步：请选择需要生成目录的对象...")<br />   (setq ss (ssget (list '(0 . "insert") (cons 2 blkname))))<br />   (setq        index0 0<br />         index  (sslength ss)<br />         sslist '()<br />   )<br />   (repeat index<br />     (setq sslist (cons (ssname ss index0) sslist))<br />     (setq index0 (1+ index0))<br />   )<br />   ;;开始构建图元点位表<br />   (setq        index0 0<br />         sslist_ptl<br />          '()<br />         tmp_pt '()<br />   )<br />   (repeat index<br />     (setq tmp_pt<br />            (cons<br />              (nth index0 sslist)<br />              (cons (cdr (assoc 10 (entget (nth index0 sslist)))) tmp_pt)<br />            )<br />     )<br />     (setq sslist_ptl (cons tmp_pt sslist_ptl))<br />     (setq tmp_pt '())<br />     (setq index0 (1+ index0))<br />   )<br />   ;;开始排序<br />   ;;从左到右从上到下<br />   (setq        XZ_sortlist<br />          (vl-sort<br />            (vl-sort sslist_ptl<br />                     '(lambda (s1 s2) (> (cadadr s1) (cadadr s2)))<br />            )<br />            '(lambda (s3 s4)<br />               (if (equal (cadadr s3) (cadadr s4) 300)<br />                 (< (caadr s3) (caadr s4))<br />               )<br />             )<br />          )<br />   )<br />   (setq i 0)<br />   (setq lst '())<br />   (setq lst0 '())<br />   (while (< i (length XZ_sortlist))<br />     (setq tk (car (nth i XZ_sortlist)))<br />     (get_att)<br />     (setq name (cdr (assoc nametag shuxing)))<br />     (setq num (cdr (assoc numtag shuxing)))<br />     (setq lst0 (list name num))<br />     (setq lst (cons lst0 lst))<br />     (setq i (+ i 1))<br />   )<br />   (setq lst (reverse lst))<br />   (setq path (getvar 'DWGPREFIX))<br />   (setq drawingname (vl-filename-base (getvar 'DWGNAME)))<br />   (setq file (open (strcat path drawingname "图纸目录.txt") "w"))<br />   (setq i 0)<br />   (while (< i (length lst))<br />     (write-line<br />       (strcat (car (nth i lst)) " " (cadr (nth i lst)))<br />       file<br />     )<br />     (setq i (+ i 1))<br />   )<br />   (close file)<br />   (setvar "filedia" 1)<br />   (princ)<br /> )<br /> <br /> <br /> (defun get_att ()<br />   (setq obj (vlax-ename->vla-object tk))<br />   (setq        shuxing<br />          (mapcar '(lambda (att)<br />                     (cons (vla-get-TagString att) (vla-get-TextString att))<br />                   )<br />                  (vlax-invoke obj "GetAttributes")<br />          )<br />   )<br /> )<br /> <br /> (defun choose_att (/ a b)<br />   (if (setq a (entsel))<br />     (progn (setq b (car (nentselp (cadr a)))) ;图元名<br />            (if (/= (cdr (assoc 0 (entget b))) "ATTRIB") ;图元属性<br />              (progn (alert "******必须选择属性字!******")<br />                     (choose_att)<br />              )<br />              (cons (cdr (assoc 2 (entget b)))<br />                    (cdr (assoc 2 (entget (car a))))<br />              )<br />            )<br />     )<br />     (progn (alert "******必须选择属性字!******")<br />            (choose_att)<br />     )<br />   )<br /> )

KO你

gaics 发表于 2019-7-31 14:59
从左到右、从上到下跟图框的基点、对齐方式有很大关系。

太感谢 gaics 大师的热心帮忙 正是我想要的

KO你

gaics 发表于 2019-7-26 16:26
从左到右、从上到下跟图框的基点、对齐方式有很大关系。

gaics大师，如果目录需要   子项名称+图纸名称+图号   
再打个比较，如果图纸名比较长，可能某一张图分了两行或三行，怎么才能办到，
又或者只需要图名不需要图号。可以多选择生成目录
不懂编程的我只能求助大师，万分感谢。
在二楼回贴的基础上修改
求：
第一项点选子项名称，可以多选也可以空选，空格跳至第二项
第二项点选图纸名称，可以多选也可以空选，空格跳至第三项
第三项点选图号编号，单选也可以空选，空格完成

gaics

KO你 发表于 2019-12-31 20:16
gaics大师，如果目录需要   子项名称+图纸名称+图号   
再打个比较，如果图纸名比较长，可能某一张图分 ...

我试试吧，这个比较耗精力

KO你

gaics 发表于 2020-4-19 10:25
我试试吧，这个比较耗精力

太感谢了，期待中

gaics

KO你 发表于 2020-4-19 12:06
太感谢了，期待中

子项名称已加入，可实现空选。多选还在研究中。

gaics

可多选、可空选。
按回车键、空格键、鼠标右键、鼠标左键点击空白处，四种方式均可以用来确认选择或跳过选择。

KO你

gaics 发表于 2020-4-19 15:56
可多选、可空选。
按回车键、空格键、鼠标右键、鼠标左键点击空白处，四种方式均可以用来确认选择或跳过选 ...

两个都试过了，运行不了，不知道是什么问题

gaics

KO你 发表于 2020-4-19 22:32
两个都试过了，运行不了，不知道是什么问题

是否整个文件都替换？子程序都有改动