Entmake 符号表的必要条件

自贡黄明儒

1. ;;Entmake 符号表的必要条件
   
2. (defun C:w4 (/ DATA FLN FLO I L1 LST NEWNAME OLDNAME YAO)
   
3.   (cond        ((and (setq FLN (getfiled "輸出的LISP文件:" "" "LSP" 1))
   
4.               (setq FLO (open FLN "w"))
   
5.          )
   
6.          (setq lst '("Layer" "Ltype" "View" "Style" "Appid" "Ucs" "Dimstyle" "Vport"))
   
7.          (setq L1 '("AcDbLayerTableRecord"                "AcDbLinetypeTableRecord"
   
8.                      "AcDbViewTableRecord"                "AcDbTextStyleTableRecord"
   
9.                      "AcDbRegAppTableRecord"                "AcDbUCSTableRecord"
   
10.                      "AcDbDimStyleTableRecord"                "AcDbViewportTableRecord"
    
11.                     )
    
12.          )
    
13.          (foreach n lst
    
14.            (setq yao nil)
    
15.            (setq data (TBLNEXT n T))
    
16.            (setq yao (cons (car data) yao))
    
17.            (setq data (cdr data))
    
18.            (setq yao (cons '(100 . "AcDbSymbolTableRecord") yao))
    
19.            (setq yao (cons (cons 100 (car L1)) yao))
    
20.            (setq L1 (cdr L1))          
    
21.            (foreach X data (setq yao (cons x yao)))
    
22.            (setq yao (REVERSE yao))
    
23.            (setq i 0)
    
24.            (setq lst nil)
    
25.            (setq oldName (cdr (assoc 2 yao)))
    
26.            (foreach X yao
    
27.              (setq i (1+ i))
    
28.              (setq NewName (strcat oldname (VL-PRINC-TO-STRING i)))
    
29.              (setq data (subst (cons 2 NewName) (assoc 2 yao) yao))
    
30.              (cond ((not (entmakeX (vl-remove X data))) (setq lst (cons X lst))))
    
31.            )
    
32.            (setq lst (reverse lst))             
    
33.            (write-line (strcat "(EntMakeX '" (vl-prin1-to-string lst) ")") FLO)
    
34.          )
    
35.          (close FLO)
    
36.         )
    
37.   )
    
38.   (princ)
    
39. )
    

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

结果:
;;符号表的必要条件
  (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

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

xj6019

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

start4444

谢谢!  分享程序!!!!

mokson

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

海盗曹

学习下黄大师的代码

LIULISHENG

这个太好了