图纸目录函数，原函数默认图号在上，图名在下，是否可以实现图号在下，图名在上

注册

图纸目录函数，原函数默认图号在上，图名在下，是否可以实现图号在下，图名在上，与一般的单位图框编制一样？

;;;  ====================================
;;;  PEACE zhptj1986@gmail.com
;;;  http://blog.sina.com.cn/peacelvirene
;;;  ZIAD浙江省建筑设计研究院
;;;  ===============================
;;;  图纸目录整理(必须图框中图号在上，图名在下才可用;先执行选择-再执行整理)
;;;  命令：PEACE-DwgList
;;;  by PEACE 2013/09/12 V1.0
;;;  ===============================
(vl-load-com)
(defun c:PEACE-DwgList( /
               ;局部函数
               *error*
               PEACE:StoreSysVarCAD
               PEACE:RestoreSysVarCAD
               PEACE:SaveSysVarPeace
               PEACE:ReadSysVarPeace
               PEACE:Fsxm-ssget
               SaveSysVar
               GETDATA
               ;局部变量
               vcmde vblip vclay vosmo vplwd vlupr vdelo vtsty ;系统变量
               dclname tempname filen stream dcl_re
               stylelist style stylen layerlist layer layern qzlist qzn
               textss tn textdata texti texth dwgn tp1 tp2 findl tmtextss
               dwglist tm i j textj p1 p2 t1 t2 tmlist texty
               ;全局变量
                              )
;局部函数开始
;自定义错误处理函数
(defun *error* (msg)
  (PEACE:RestoreSysVarCAD) ;还原系统变量
  (command ".UNDO" "E")
  (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
      (princ (strcat "\n** Error: " msg " **")))
  (princ)
)
;储存系统变量
(defun PEACE:StoreSysVarCAD()
  (setq vcmde (getvar "cmdecho"))  ;普通命令的提示
  (setq vblip (getvar "blipmode")) ;光标痕迹
  (setq vclay (getvar "CLAYER"))   ;图层
  (setq vosmo (getvar "osmode"))   ;捕捉模式
  (setq vplwd (getvar "plinewid")) ;pl宽度
  (setq vlupr (getvar "luprec"))   ;长度精度
  (setq vdelo (getvar "delobj"))   ;控制创建面域时是否保留原pline，0为保留，1为不保留
  (setq vtsty (getvar "textstyle"))
)
;还原系统变量
(defun PEACE:RestoreSysVarCAD()
  (setvar "cmdecho" vcmde)
  (setvar "blipmode" vblip)
  (setvar "CLAYER" vclay)
  (setvar "osmode" vosmo)
  (setvar "plinewid" vplwd)
  (setvar "luprec" vlupr)
  (setvar "delobj" vdelo)
  (setvar "textstyle" vtsty)
)
;保存peace系统变量
(defun PEACE:SaveSysVarPeace(valname valvalue infotext / acadpath f datalist data valvalue_old i isthere)
  (setq acadpath(vlax-get-property (vlax-get-acad-object) 'Path))
  (if (= infotext "")(setq infotext "no infotext"))
  (if (null (findfile "EACESYSVAL.TXT"))
    (progn ;若文件不存在
      (setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "w"))
      (prin1 (list valname valvalue infotext) f)
      (close f)
    )
    (progn ;若文件已存在
      (setq datalist '())
      (setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "r"))
        (while (setq data (read-line f))
              (setq datalist (cons data datalist))
        )
      (close f)
      (setq datalist (reverse datalist))
      (setq       i 0
            isthere 0)
      (repeat (length datalist)
        (if (= valname (car (read (nth i datalist))))
          (progn
          (setq datalist (subst (vl-prin1-to-string (list valname valvalue infotext)) (nth i datalist) datalist))
          (setq isthere 1)
          )
        )
        (setq i (1+ i))
      )
      (if (= 1 isthere)
        (progn
          (setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "w"))
          (prin1 (read (nth 0 datalist)) f)
          (close f)
          (setq i 1)
          (setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "a"))
          (repeat (- (length datalist) 1)
            (write-line "" f)
            (prin1 (read (nth i datalist)) f)
            (setq i (1+ i))
          )
          (close f)
        )
        (progn
          (setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "a"))
          (write-line "" f)
          (prin1 (list valname valvalue infotext) f)
          (close f)
        )
      )
    )
  )
  (princ)
)
;读取peace系统变量
(defun PEACE:ReadSysVarPeace( / acadpath data datalist i f)
  (setq acadpath(vlax-get-property (vlax-get-acad-object) 'Path))
  (if (findfile "EACESYSVAL.TXT")
    (progn
    (setq datalist '())
    (setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "r"))
      (while (setq data (read-line f))
            (setq datalist (cons data datalist))
      )
      (reverse datalist)
    (close f)
    (setq i 0)
    (repeat (length datalist)
      (set (read (car (read (nth i datalist)))) ;注意字符和表之间的转换，字符串是不能作为变量名的
           (cadr (read (nth i datalist)))       ;car对字符串也是不起作用的
      )
      (setq i (1+ i))
    )
    )
  nil
  )
)
;;带关键字的ssget
;;Msg=提示信息，Kwd=关键字，Fil=条件
;示例：(PEACE:Fsxm-ssget "\n请选择一个圆：" "F" '((0 . "circle")))
(defun PEACE:Fsxm-ssget (Msg Kwd Fil / Kwd0 pt var *acad* *doc*)
  (setq *acad* (vlax-get-acad-object))
  (setq *doc* (vla-get-ActiveDocument *acad*))
  ;===内部函数开始===
  ;;带过滤器的entsel
  (defun Fsxm-entsel (msg filter)
    (setq enp (entsel msg))
    (if (or (= (type enp) 'str)
           (and enp (ssget (cadr enp) filter))
        )
     enp
    )
  )
  ;;;用分隔符解释字符串成表
  (defun Fsxm-Split (string strkey / po strlst xlen)
    (setq xlen (1+ (strlen strkey)))
    (while (setq po (vl-string-search strkey string))
      (setq strlst (cons (substr string 1 po) strlst))
      (setq string (substr string (+ po xlen)))
    )
    (reverse (cons string strlst))
  )
  ;;点化字串
  (defun Fsxm-Pt2Str (pt)
    (strcat (rtos (car pt) 2 2)
            ","
            (rtos (cadr pt) 2 2)
            ","
            (rtos (caddr pt) 2 2)
            "\n"
    )
  )
  ;===内部函数结束===
  (cond
        ((cadr (ssgetfirst)))
        (T
         (setq Kwd0 "W L C BOX ALL F WP CP G A R M P U AU SI")
         (initget (strcat Kwd0 " " kwd))
         (cond ((and (listp (setq var (Fsxm-entsel Msg Fil)))
                     (/= 52 (getvar "errno"))
                )
                (vla-sendcommand *doc* (Fsxm-Pt2Str (cadr (grread t))))
                (ssget Fil)
               )
               ((member var (Fsxm-Split Kwd0 " "))
                (vla-sendcommand *doc* (strcat var "\n"))
                (ssget Fil)
               )
               (t var)
         )
        )
  )
)
;;;由左下点PA和右上点PB得到矩形的9个特征点 by peace 2013/08/29
;;;左下点开始依次为p0 p1...中心点为p8
(defun PEACE:Point_9pt (pa pb / p0 P1 P2 P3 P4 P4 P5 P6 P7 P8)
  (setq p0 (list (car pa) (cadr pa))
        p4 (list (car pb) (cadr pb))
        p2 (list (car p4) (cadr p0))
        p6 (list (car p0) (cadr p4))
        p1 (list (* 0.5 (+ (car p0)(car p2)))(* 0.5 (+ (cadr p0)(cadr p2))))
        p3 (list (* 0.5 (+ (car p2)(car p4)))(* 0.5 (+ (cadr p2)(cadr p4))))
        p5 (list (* 0.5 (+ (car p4)(car p6)))(* 0.5 (+ (cadr p4)(cadr p6))))
        p7 (list (* 0.5 (+ (car p0)(car p6)))(* 0.5 (+ (cadr p0)(cadr p6))))
        p8 (list (* 0.5 (+ (car p0)(car p4)))(* 0.5 (+ (cadr p0)(cadr p4))))
  )
  (list p0 p1 p2 p3 p4 p5 p6 p7 p8)
)
;;;由pt1根据Δx\Δy\Δz得到pt2  by PEACE 2013/07/06
;;;对于二维点和三维点均适用，二维点时dz不起作用
(defun PEACE:Point_Offset (pt1 dx dy dz / x y z pt2)
  (setq x (+ (car pt1) dx)
        y (+ (cadr pt1) dy)
  )
  (if (= (length PT1) 3)
    (setq z (+ (caddr pt1) dz)
        pt2 (list x y z)
    )
    (setq pt2 (list x y))
  )     
  pt2
)
;来源http://bbs.mjtd.com/thread-9546-1-1.html[提供者：aeo000000]
;(PEACE:Sort_xy li '(>))  只按x由大到小
;(PEACE:Sort_xy li '(<))  只按x由小到大
;(PEACE:Sort_xy li '(nil >))    只按y由大到小
;(PEACE:Sort_xy li '(nil <))    只按y由小到大
;其余x和y组合的情况类推
(defun PEACE:Sort_xy (li how / a)
(if(setq a(car how))(setq li(vl-sort li '(lambda(x y)((eval a)(car x)(car y))))))
(if(setq a(cadr how))(setq li(vl-sort li '(lambda(x y)((eval a)(cadr x)(cadr y))))))
li
)
;保存变量
(defun SaveSysVar()
  (PEACE:SaveSysVarPeace "1309:DWGL_BZ" P1309:DWGL_BZ "EACE-DwgList步骤")
  (PEACE:SaveSysVarPeace "1309:DWGL_QZ" P1309:DWGL_QZ "EACE-DwgList图号前缀")
  (PEACE:SaveSysVarPeace "1309:DWGL_FW" P1309:DWGL_FW "EACE-DwgList搜索范围")
  (PEACE:SaveSysVarPeace "1309:DWGL_H" P1309:DWGL_H "EACE-DwgList字高")
  (PEACE:SaveSysVarPeace "1309:DWGL_D" P1309:DWGL_D "EACE-DwgList行距")
  (PEACE:SaveSysVarPeace "1309:DWGL_C" P1309:DWGL_C "EACE-DwgList颜色")
  (PEACE:SaveSysVarPeace "1309:DWGL_S" P1309:DWGL_S "EACE-DwgList样式")
  (PEACE:SaveSysVarPeace "1309:DWGL_L" P1309:DWGL_L "EACE-DwgList图层")
)
;获取数据
(defun GETDATA()
  (setq P1309:DWGL_QZ (get_tile "ea201"))
  (setq P1309:DWGL_FW (atof (get_tile "ea203")))
  (setq P1309:DWGL_H (atof (get_tile "ea301")))
  (setq P1309:DWGL_D (atof (get_tile "ea302")))
  (setq P1309:DWGL_C (atof (get_tile "ea303")))
  (setq P1309:DWGL_S (get_tile "ea304"))
  (setq P1309:DWGL_L (get_tile "ea306"))
)
;局部函数结束
;主函数开始
  (PEACE:StoreSysVarCAD)  ;储存系统变量
  (PEACE:ReadSysVarPeace) ;读取peace系统变量
  (setvar "cmdecho" 0)
  (command ".UNDO" "BE")
  (if (not P1309:DWGL_BZ)(setq P1309:DWGL_BZ 1));步骤
  (if (not P1309:DWGL_FW)(setq P1309:DWGL_FW 4));搜索范围
  (if (not P1309:DWGL_H)(setq P1309:DWGL_H 350));文字高度
  (if (not P1309:DWGL_D)(setq P1309:DWGL_D 200));文字间距
  (if (not P1309:DWGL_C)(setq P1309:DWGL_C 2));文字颜色
  (setq stylelist '())
  (vlax-for style
            (vla-get-textstyles (vla-get-activedocument (vlax-get-acad-object)))
            (setq stylelist  (cons (vla-get-name style) stylelist))
  )
  (setq stylelist (acad_strlsort stylelist))
  (setq layerlist '())
  (vlax-for layer
            (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
            (setq layerlist  (cons (vla-get-name layer) layerlist))
  )
  (setq layerlist (acad_strlsort layerlist))
  (setq qzlist (list "结施-" "结初-" "建施-" "建初-"))
  (if (not P1309:DWGL_S)(setq P1309:DWGL_S (nth 0 stylelist)));文字样式
  (if (not P1309:DWGL_L)(setq P1309:DWGL_L (nth 0 layerlist)));文字图层
  (if (not P1309:DWGL_QZ)(setq P1309:DWGL_QZ (nth 0 qzlist)));图号前缀
  (if (not (setq stylen (vl-position P1309:DWGL_S stylelist))) (setq stylen 0))
  (if (not (setq layern (vl-position P1309:DWGL_L layerlist))) (setq layern 0))
  (if (not (setq qzn (vl-position P1309:DWGL_QZ qzlist))) (setq qzn 0))
  (setq dclname
    (cond
      ((setq tempname (vl-filename-mktemp "EACEDCL.dcl")
                            filen (open tempname "w")
           )
           (foreach stream
                 '("\n" "dcl01:dialog {\n"
                    "    label=\"图纸目录\"; \n"
                    "    :boxed_row{label=\"选择步骤\"; \n"
                    "      :radio_button{label=\"选取\";key=\"ea101\";mnemonic=\"1\";value=1; }\n"
                    "      :radio_button{label=\"整理\";key=\"ea102\";mnemonic=\"2\"; }\n"
                    "              } \n"
                    "    :boxed_row{label=\"搜索设置\"; \n"
                    "      :column{ \n"
                    "        :edit_box{label=\"图号前缀\";key=\"ea201\";width=10;height=1.0;} \n"
                    "        :popup_list{key=\"ea202\";edit_width=17;height=1.0;} \n"
                    "        :row{ \n"
                    "          :edit_box{label=\"搜索范围\";key=\"ea203\";width=5;height=1.0; }  \n"
                    "          :text{label=\"倍字高\" ; } \n"
                    "            } \n"
                    "             } \n"
                    "              } \n"
                    "    :boxed_row{label=\"书写设置\"; \n"
                    "      :column{ \n"
                    "        :edit_box{label=\"文字字高\";key=\"ea301\";width=10;height=1.0;} \n"
                    "        :edit_box{label=\"净行间距\";key=\"ea302\";width=10;height=1.0;} \n"
                    "        :edit_box{label=\"文字颜色\";key=\"ea303\";width=10;height=1.0;} \n"
                    "        :edit_box{label=\"文字样式\";key=\"ea304\";width=10;height=1.0;} \n"
                    "        :popup_list{key=\"ea305\";edit_width=17;height=1.0;} \n"
                    "        :edit_box{label=\"文字图层\";key=\"ea306\";width=10;height=1.0;} \n"
                    "        :popup_list{key=\"ea307\";edit_width=17;height=1.0;} \n"
                    "             } \n"
                    "              } \n"
                        "    ok_cancel;"
                    "    }"
              )
                  (princ stream filen)
           )
           (close filen)
           tempname
          )
    )
  )
  (setq dcl_re (load_dialog dclname))
  (if (not (new_dialog "dcl01" dcl_re))
    (exit)
  )
  (mode_tile "accept" 2)
  (cond
    ((= P1309:DWGL_BZ 1) (set_tile "ea101" "1"))
    ((= P1309:DWGL_BZ 2) (set_tile "ea102" "1"))
  )
  (start_list "ea202")
  (mapcar 'add_list qzlist)
  (end_list)
  (start_list "ea305")
  (mapcar 'add_list stylelist)
  (end_list)
  (start_list "ea307")
  (mapcar 'add_list layerlist)
  (end_list)
  (set_tile "ea201" P1309:DWGL_QZ)
  (set_tile "ea202" (rtos qzn 2 0))
  (set_tile "ea203" (rtos P1309:DWGL_FW 2 2))
  (set_tile "ea301" (rtos P1309:DWGL_H 2 2))
  (set_tile "ea302" (rtos P1309:DWGL_D 2 2))
  (set_tile "ea303" (rtos P1309:DWGL_C 2 0))
  (set_tile "ea304" P1309:DWGL_S)
  (set_tile "ea305" (rtos stylen 2 0))
  (set_tile "ea306" P1309:DWGL_L)
  (set_tile "ea307" (rtos layern 2 0))
  (action_tile "ea101" "(setq P1309:DWGL_BZ 1)")
  (action_tile "ea102" "(setq P1309:DWGL_BZ 2)")
  (action_tile "ea202" "(setq qzn $value)(setq P1309:DWGL_QZ (nth (atoi qzn) qzlist))(set_tile \"ea201\" P1309:DWGL_QZ)")
  (action_tile "ea305" "(setq stylen $value)(setq P1309:DWGL_S (nth (atoi stylen) stylelist))(set_tile \"ea304\" P1309:DWGL_S)")
  (action_tile "ea307" "(setq layern $value)(setq P1309:DWGL_L (nth (atoi layern) layerlist))(set_tile \"ea306\" P1309:DWGL_L)")
  (action_tile "accept" "(GETDATA)(SaveSysVar)(done_dialog)")
  (action_tile "cancel" "(done_dialog)")
  (start_dialog)
  (unload_dialog dcl_re)
  (vl-file-delete dclname)
  (setq textss (PEACE:Fsxm-ssget "\n>>> 请选择图号和图名<退出>：" "   " (list '(0 . "*TEXT"))))
  (cond
    (
      (or (= textss nil)(= textss ""))
      (princ "\n*** 程序退出!")
    )
    (
      t
      (setq i 0 tn (strlen P1309:DWGL_QZ) dwglist '())
      (cond
        ((= tn 0)(princ "\n*** 目前必须设置图号前缀! 程序退出!"))
        (t
          (repeat (sslength textss)
            (setq textdata (entget (ssname textss i))
                     texti (cdr (assoc 1 textdata))
                     texth (cdr (assoc 40 textdata))
            )
            (if (= (substr texti 1 tn) P1309:DWGL_QZ)
              (progn
                (cond
                  ( ;选取
                    (= P1309:DWGL_BZ 1)
                    (vla-GetBoundingBox (vlax-ename->vla-object (ssname textss i)) 'cor1 'cor2)
                    (setq dwgn (atoi (substr texti (1+ tn)))
                           tp1 (nth 0 (PEACE:Point_9pt (vlax-safearray->list cor1) (vlax-safearray->list cor2)))
                         findl (* P1309:DWGL_FW texth)
                           tp2 (PEACE:Point_Offset tp1 findl (- findl) 0)
                      tmtextss (ssget "C" tp1 tp2)
                    )
                  )
                  ( ;整理
                    (= P1309:DWGL_BZ 2)
                    (vla-GetBoundingBox (vlax-ename->vla-object (ssname textss i)) 'cor1 'cor2)
                    (setq dwgn (atoi (substr texti (1+ tn)))
                           tp1 (nth 2 (PEACE:Point_9pt (vlax-safearray->list cor1) (vlax-safearray->list cor2)))
                         findl (* P1309:DWGL_FW texth)
                           tp2 (PEACE:Point_Offset tp1 findl (* 0.5 texth) 0)
                      tmtextss (ssget "C" tp1 tp2)
                    )
                  )
                )
                (if (= (sslength tmtextss) 0)
                  (setq tm "**未找到图名**")
                  (progn
                    (setq j 0 tm "" tmlist '())
                    (repeat (sslength tmtextss)
                      (if (not (equal (ssname textss i) (ssname tmtextss j)))
                        (if (vl-position (cdr (assoc 0 (entget (ssname tmtextss j)))) (list "TEXT" "MTEXT"))
                          (progn
                            (vla-GetBoundingBox (vlax-ename->vla-object (ssname tmtextss j)) 'cor1 'cor2)
                            (setq textj (cdr (assoc 1 (entget (ssname tmtextss j))))
                                  texty (cadr (nth 0 (PEACE:Point_9pt (vlax-safearray->list cor1) (vlax-safearray->list cor2))))
                                 tmlist (cons (list texty textj) tmlist)
                            )

                          )
                        )
                      )
                      (setq j (1+ j))
                    )
                    (setq tmlist (PEACE:Sort_xy tmlist '(>)) j 0)
                    (repeat (length tmlist)
                      (if (= tm "")
                        (setq tm (cadr (nth j tmlist)))
                        (setq tm (strcat tm "、" (cadr (nth j tmlist))))
                      )
                      (setq j (1+ j))
                    )
                  )
                )
                (setq dwglist (cons (list dwgn texti tm) dwglist))
              )
            )
            (setq i (1+ i))
          )
          (setq dwglist (PEACE:Sort_xy dwglist '(<)))
        )
      )
      (setq p1 (getpoint "\n>>> 指定书写基准点[右上角点]:"))
      (setq i 0)
      (repeat (length dwglist)
        (setq p1 (PEACE:Point_Offset p1 0 (- (+ P1309:DWGL_H P1309:DWGL_D)) 0)
              p2 (PEACE:Point_Offset p1 (* 6 P1309:DWGL_H) 0 0)
              t1 (nth 1 (nth i dwglist))
              t2 (nth 2 (nth i dwglist))
        )
        (entmake (list '(0 . "TEXT")
                    (cons 62 (atoi (rtos P1309:DWGL_C 2 0)))
                    (cons 72 0)
                    (cons 73 1)
                    (cons 8 P1309:DWGL_L)
                    (cons 7 P1309:DWGL_S)
                    (cons 1 t1)
                    (cons 10 p1)
                    (cons 11 p1)
                    (cons 40 P1309:DWGL_H)
                    (cons 41 0.8)
                    (cons 50 0)
                ))
        (entmake (list '(0 . "TEXT")
                    (cons 62 (atoi (rtos P1309:DWGL_C 2 0)))
                    (cons 72 0)
                    (cons 73 1)
                    (cons 8 P1309:DWGL_L)
                    (cons 7 P1309:DWGL_S)
                    (cons 1 t2)
                    (cons 10 p2)
                    (cons 11 p2)
                    (cons 40 P1309:DWGL_H)
                    (cons 41 0.8)
                    (cons 50 0)
                ))
        (setq i (1+ i))
      )
      (princ "\n*** 图纸目录生成完成!")
    )
  )
  (command ".UNDO" "E")
  (PEACE:RestoreSysVarCAD)
  (princ)
)
(princ)

注册

我去，这么多笑脸，上lsp吧

xiangganglv

能上动图吗？

bai2000

属性块图框，图名、图号选不上

ssyfeng

如果可以上一个测试文件就好了

花不落

不会用真着急。

江南十笑

上传一个动图介绍下怎么用吧

wline

选不上，完全选不上啊

kozmosovia

上下文字对应的DXF10 11互换一下不就上下文字反过来了。