求助：更改程序

seamopan

这个程序可以正常运行输出TXT文件，求助大神怎么更改为直接输出列表到CAD中，最好能加上表头类别；

(defun c:mn (/              blkname  zxtag        nametag         numtag          shuxing
             ss              sslist   file        index0         index          tmp_pt
             XZ_sortlist       s1        s2         s3          s4
             lst0     lst      i        ii         tk          sslist_ptl
             path     drawingname   )
  (setvar "cmdecho" 0)
  (princ "\n第1步：请选择“子项”属性字...")
  (setq zxtag (multi_select))
  (princ "\n第2步：请选择“图名”属性字...")
  (setq nametag (multi_select))
  (princ "\n第3步：请选择“图号”属性字...")
  (if (setq numtag (choose_att2))
    (progn (setq blkname (cdr numtag))
           (setq numtag (car numtag))
    )  )
  (princ "\n第4步：请选择需要生成目录的对象...")
  (setq ss (ssget (list '(0 . "insert") (cons 2 blkname))))
  ;;"blkname"from(multi_select)
  (setq        index0 0
        index  (sslength ss)
        sslist '()  )
  (repeat index
    (setq sslist (cons (ssname ss index0) sslist))
    (setq index0 (1+ index0))  )
  ;;开始构建图元点位表
  (setq        index0 0
        sslist_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))  )
  ;;开始排序
  ;;从左到右从上到下
  (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) 300)
                (< (caadr s3) (caadr s4))
              )    ) )  )
  (setq i 0)
  (setq lst '())
  (while (< i (length XZ_sortlist))
    (setq tk (car (nth i XZ_sortlist)))
    (setq shuxing (get_att tk))
    (setq lst0 '())
    (if        zxtag
      (setq lst0 (cons (str_value zxtag shuxing) lst0))
    )
    (if        nametag
      (setq lst0 (cons (str_value nametag shuxing) lst0))
    )
    (if        numtag
      (setq lst0 (cons (cdr (assoc numtag shuxing)) lst0))
    )
    (setq lst (cons (reverse lst0) lst))
    (setq i (+ i 1))
  )
  (setq lst (reverse lst))
  (setq path (getvar 'DWGPREFIX))
  (setq drawingname (vl-filename-base (getvar 'DWGNAME)))
  (setq file (open (strcat path drawingname "图纸目录.txt") "w"))
  (setq i 0)
  (while (< i (length lst))
    (write-line
      (vl-string-trim "()" (vl-princ-to-string (nth i lst)))
      file
    )
    (setq i (+ i 1))
  )
  (close file)
  (princ)
)

(defun get_att (tk)
  (setq obj (vlax-ename->vla-object tk))
  (mapcar '(lambda (att)
             (cons (vla-get-TagString att) (vla-get-TextString att))
           )
          (vlax-invoke obj "GetAttributes")
  ))

(defun choose_att2 (/ a b)
  (if (setq a (entsel))
    (progn (setq b (car (nentselp (cadr a)))) ;图元名
           (if (/= (cdr (assoc 0 (entget b))) "ATTRIB") ;图元属性
             (progn (alert "******必须选择属性字!******")
                    (choose_att)
             )
             (cons (cdr (assoc 2 (entget b)))
                   (cdr (assoc 2 (entget (car a))))
            )           )    )  ))

(defun multi_select (/ a b)
  (setq b '())
  (while (setq a (choose_att2))
    (setq blkname (cdr a))
    (if        b
      (setq b (cons (car a) b))
      (setq b (list (car a)))
    )
    (princ "请继续选择，如已完成请按空格键或鼠标右键...")
  )
  (reverse b) )
(defun str_value (tag shuxing / ii value lst)
  (setq ii 0)
  (while (< ii (length tag))
    (setq value (cdr (assoc (nth ii tag) shuxing)))
    (setq lst (cons value lst))
    (setq value (apply 'strcat (reverse lst)))
    (setq ii (1+ ii))
  )
  value
)

start4444

seamopan 发表于 2022-3-15 23:01
大佬，每项的多选内容之间能用加 - 短划线隔开吗？

(defun str_value (tag shuxing / ii value lst)
  (setq ii 0)
  (while (< ii (length tag))
    (setq value (cdr (assoc (nth ii tag) shuxing)))
    (if (= 0 ii) (setq lst (cons value lst)) (setq lst (cons (strcat "-" value) lst)))
    (setq value (apply 'strcat (reverse lst)))
    (setq ii (1+ ii))
  )
  value
)

替换旧的

seamopan

gaics 发表于 2022-3-10 07:40
一个功能简单的自动生成图纸目录程序
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=96502&fromuid ...

这个帖子里面两个版本的程序我都下载源码试用了，提取内容不能完全实现我这边实际的结果，这几个源码都下载了但自己不会修改为直接输出到cad中，能帮忙给本帖的这个程序改下么？直接输出到cad中（程序绘制列表表格线和文本的图层都可以直接放在当前层就可以，不用单独新建图层和文本图层）

gaics

有现成的。搜索一下

seamopan

gaics 发表于 2022-3-9 13:15
有现成的。搜索一下

谢谢您的回帖，我也在网上搜索了有好几种生成目录的程序，目前找到了这个目录源码更接近我现在所需要的（可以选择点选自己想要的属性内容然后输出到列表，这样可以根据不同时候对属性内容的输出选择），能否烦请您帮忙给这个源码改为直接输出到CAD

gaics

seamopan 发表于 2022-3-9 21:41
谢谢您的回帖，我也在网上搜索了有好几种生成目录的程序，目前找到了这个目录源码更接近我现在所需要的（ ...

一个功能简单的自动生成图纸目录程序
http://bbs.mjtd.com/forum.php?mo ... &fromuid=410342
(出处: 明经CAD社区)

p-3-ianlcc

gaics 发表于 2022-3-10 07:40
一个功能简单的自动生成图纸目录程序
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=96502&fromuid ...

不好意思
我第一次使用这个LSP…
我想请教一下，运行后会出现要求输入属性字
请问有没有操作的GIF可以参考？

mokson

不好意思，我看着那些括号，眼花了。

start4444

把子项去掉了，就图名 图号差不多，68行可以自行设定字高，行距什么的

seamopan

非常感谢

seamopan

start4444 发表于 2022-3-12 10:53
把子项去掉了，就图名 图号差不多，68行可以自行设定字高，行距什么的

很感谢您帮忙给改好了想要的程序效果，如果能再加几项能否实现图片中的效果啊，每一项的选择可以允许空选（空选项可以不输出在列表中）