自贡黄明儒 发表于 2021-1-11 11:20:32

Entmake 符号表的必要条件

;;Entmake 符号表的必要条件
(defun C:w4 (/ DATA FLN FLO I L1 LST NEWNAME OLDNAME YAO)
(cond        ((and (setq FLN (getfiled "輸出的LISP文件:" "" "LSP" 1))
              (setq FLO (open FLN "w"))
       )
       (setq lst '("Layer" "Ltype" "View" "Style" "Appid" "Ucs" "Dimstyle" "Vport"))
       (setq L1 '("AcDbLayerTableRecord"                "AcDbLinetypeTableRecord"
                     "AcDbViewTableRecord"                "AcDbTextStyleTableRecord"
                     "AcDbRegAppTableRecord"                "AcDbUCSTableRecord"
                     "AcDbDimStyleTableRecord"                "AcDbViewportTableRecord"
                  )
       )
       (foreach n lst
           (setq yao nil)
           (setq data (TBLNEXT n T))
           (setq yao (cons (car data) yao))
           (setq data (cdr data))
           (setq yao (cons '(100 . "AcDbSymbolTableRecord") yao))
           (setq yao (cons (cons 100 (car L1)) yao))
           (setq L1 (cdr L1))          
           (foreach X data (setq yao (cons x yao)))
           (setq yao (REVERSE yao))
           (setq i 0)
           (setq lst nil)
           (setq oldName (cdr (assoc 2 yao)))
           (foreach X yao
             (setq i (1+ i))
             (setq NewName (strcat oldname (VL-PRINC-TO-STRING i)))
             (setq data (subst (cons 2 NewName) (assoc 2 yao) yao))
             (cond ((not (entmakeX (vl-remove X data))) (setq lst (cons X lst))))
           )
           (setq lst (reverse lst))             
           (write-line (strcat "(EntMakeX '" (vl-prin1-to-string lst) ")") FLO)
       )
       (close FLO)
        )
)
(princ)
)


结果:
;;符号表的必要条件
(EntMakeX '((0 . "LAYER")
              (100 . "AcDbSymbolTableRecord")
              (100 . "AcDbLayerTableRecord")
              (2 . "MyLAYER")
              (70 . 0)
             )
)
(EntMakeX '((0 . "LTYPE")
              (100 . "AcDbSymbolTableRecord")
              (100 . "AcDbLinetypeTableRecord")
              (2 . "MyLTYPE")
              (70 . 0)
             )
)
(EntMakeX '((0 . "VIEW")
              (100 . "AcDbSymbolTableRecord")
              (100 . "AcDbViewTableRecord")
              (2 . "MyVIEW")
              (70 . 0)
             )
)
(EntMakeX '((0 . "STYLE")
              (100 . "AcDbSymbolTableRecord")
              (100 . "AcDbTextStyleTableRecord")
              (2 . "MySTYLE")
              (70 . 0)
             )
)
(EntMakeX '((0 . "APPID")
              (100 . "AcDbSymbolTableRecord")
              (100 . "AcDbRegAppTableRecord")
              (2 . "MyAPPID")
              (70 . 0)
             )
)
(EntMakeX '((0 . "UCS")
              (100 . "AcDbSymbolTableRecord")
              (100 . "AcDbUCSTableRecord")
              (2 . "MyUCS")
              (70 . 0)
              (11 0.904145 0.427225 0.0)
              (12 -0.427225 0.904145 0.0)
             )
)
(EntMakeX '((0 . "DIMSTYLE")
              (100 . "AcDbSymbolTableRecord")
              (100 . "AcDbDimStyleTableRecord")
              (2 . "My")
              (70 . 0)
             )
)
(EntMakeX '((0 . "VPORT")
              (100 . "AcDbSymbolTableRecord")
              (100 . "AcDbViewportTableRecord")
              (2 . "My")
              (70 . 0)
             )
)

yoyoho 发表于 2021-1-11 19:43:56

谢谢! 自贡黄明儒 分享程序!!!!

xj6019 发表于 2021-1-11 21:07:52


谢谢! 自贡黄明儒 分享程序!!!!

start4444 发表于 2021-1-12 10:08:29

谢谢!分享程序!!!!

mokson 发表于 2021-1-12 10:18:01

感谢分享，给大家指正了方向。

海盗曹 发表于 2021-1-13 13:41:35

学习下黄大师的代码

LIULISHENG 发表于 2021-6-4 09:02:16

这个太好了
页: [1]
查看完整版本: Entmake 符号表的必要条件