论坛有没有能提取CAD文件的所有图层信息的lisp？ - AutoLISP/Visual LISP 编程技术 - AutoCAD论坛 - 明经CAD社区 - 第2页

liuhe 发表于 2023-9-13 17:18:37

chq168168 发表于 2023-9-13 16:30
标注样式是否可以提取出来更改成lisp文件？

手头没有自己重新写吧

chq168168 发表于 2023-9-15 08:50:57

本帖最后由 chq168168 于 2023-9-18 14:28 编辑

liuhe 发表于 2023-9-12 12:41
http://bbs.mjtd.com/thread-186295-1-1.html

部分有用
大神为什么生成的下边这段程序转成VLX运行不了呢？是不是代码有个#ID跟#DEBUG变量，这俩变量没定义的原因。
(DEFUN C:TC1( / LST N1 N2 N3 N4 LST1 ERR)
(SETQ LST (LIST
(LIST '(0 . "LAYER")'(100 . "AcDbSymbolTableRecord")'(100 . "AcDbLayerTableRecord")'(2 . "0")'(70 . 0)'(62 . 7)'(6 . "Continuous")'(290 . 1)'(370 . -3))
(LIST '(0 . "LAYER")'(100 . "AcDbSymbolTableRecord")'(100 . "AcDbLayerTableRecord")'(2 . "00-标注")'(70 . 0)'(62 . 7)'(6 . "Continuous")'(290 . 1)'(370 . -3))
(LIST '(0 . "LAYER")'(100 . "AcDbSymbolTableRecord")'(100 . "AcDbLayerTableRecord")'(2 . "00-新增")'(70 . 0)'(62 . 1)'(6 . "Continuous")'(290 . 1)'(370 . -3))
(LIST '(0 . "LAYER")'(100 . "AcDbSymbolTableRecord")'(100 . "AcDbLayerTableRecord")'(2 . "01-加工")'(70 . 0)'(62 . 7)'(6 . "Continuous")'(290 . 1)'(370 . -3))
) )(setq n1 0 n2 0 N3 0 n4 0)(FOREACH LST1 LST
(#DEBUG (#ID 2 58 30) (OR (#DEBUG (#ID 2 58 34) (TBLSEARCH "LTYPE" (#DEBUG (#ID 2 58 53) (CDR (#DEBUG (#ID 2 58 57) (ASSOC 6 LST1)))))) (#DEBUG (#ID 2 59 5) (VL-CATCH-ALL-APPLY (QUOTE vla-Load) (#DEBUG (#ID 2 61 7) (LIST (#DEBUG (#ID 2 61 13) (vla-get-Linetypes (#DEBUG (#ID 2 62 15) (vla-get-ActiveDocument (#DEBUG (#ID 2 62 39) (vlax-get-acad-object)))))) (#DEBUG (#ID 2 64 13) (CDR (#DEBUG (#ID 2 64 17) (ASSOC 6 LST1)))) (#DEBUG (#ID 2 65 13) (FINDFILE "acad.lin"))))))))
(#DEBUG (#ID 2 75 8) (IF (#DEBUG (#ID 2 75 12) (NOT (#DEBUG (#ID 2 75 17) (TBLSEARCH "LAYER" (#DEBUG (#ID 2 75 36) (CDR (#DEBUG (#ID 2 75 41) (ASSOC 2 LST1)))))))) (#DEBUG (#ID 2 76 10) (PROGN (#DEBUG (#ID 2 76 17) (IF (#DEBUG (#ID 2 76 20) (NOT (#DEBUG (#ID 2 76 24) (ENTMAKE LST1)))) (#DEBUG (#ID 2 78 12) (SETQ N1 (#DEBUG (#ID 2 78 21) (+ 1 N1)))) (#DEBUG (#ID 2 79 12) (SETQ N2 (#DEBUG (#ID 2 79 21) (+ 1 N2)))))))) (#DEBUG (#ID 2 80 10) (PROGN (#DEBUG (#ID 2 81 12) (IF (#DEBUG (#ID 2 81 16) (= X T)) (#DEBUG (#ID 2 82 14) (PROGN (#DEBUG (#ID 2 83 16) (SETQ OLDLST (#DEBUG (#ID 2 83 29) (ENTGET (#DEBUG (#ID 2 83 37) (TBLOBJNAME "layer" (#DEBUG (#ID 2 83 57) (CDR (#DEBUG (#ID 2 83 62) (ASSOC 2 LST1)))))))) NDXF (#DEBUG (#ID 2 84 29) (LIST 6 62 70 290 370)))) (#DEBUG (#ID 2 88 16) (IF (#DEBUG (#ID 2 88 20) (= XX nil)) (#DEBUG (#ID 2 88 30) (SETQ N4 (#DEBUG (#ID 2 88 39) (+ 1 N4)))))) (#DEBUG (#ID 2 89 16) (FOREACH I NDXF (#DEBUG (#ID 2 90 18) (SETQ OLDLST (#DEBUG (#ID 2 91 25) (SUBST (#DEBUG (#ID 2 91 32) (ASSOC I LST1)) (#DEBUG (#ID 2 91 47) (ASSOC I OLDLST)) OLDLST)))))) (#DEBUG (#ID 2 94 16) (ENTMOD OLDLST))))))))))
)
(#DEBUG (#ID 2 107 14) (ALERT (#DEBUG (#ID 2 107 21) (STRCAT "\n 未新建图层" (#DEBUG (#ID 2 107 38) (RTOS N1 2 0)) "个"))))
(#DEBUG (#ID 2 110 13) (ALERT (#DEBUG (#ID 2 110 20) (STRCAT "\n 新建图层" (#DEBUG (#ID 2 110 37) (RTOS N2 2 0)) "个"))))
(PRINC ) )

chq168168 发表于 2023-9-19 08:52:25

liuhe 发表于 2023-9-13 17:18
手头没有自己重新写吧

大神帮忙看看之前用你的那个提取图层的工具制作的一个lisp程序转成VLX格式之后无法运行

liuhe 发表于 2023-9-19 10:22:41

chq168168 发表于 2023-9-15 08:50
大神为什么生成的下边这段程序转成VLX运行不了呢？是不是代码有个#ID跟#DEBUG变量，这俩变量没定义的原因 ...

我是不懂为啥一堆#debug和#id我这边测试不会生成这些东西

liuhe 发表于 2023-9-19 10:26:11

chq168168 发表于 2023-9-15 08:50
大神为什么生成的下边这段程序转成VLX运行不了呢？是不是代码有个#ID跟#DEBUG变量，这俩变量没定义的原因 ...

(DEFUN C:TC1 (/ LST N1 N2 N3 N4 LST1 ERR)
(SETQ LST (LIST
      (LIST '(0 . "LAYER")
   '(100 . "AcDbSymbolTableRecord")
   '(100 . "AcDbLayerTableRecord")
   '(2 . "0")
   '(70 . 0)
   '(62 . 7)
   '(6 . "Continuous")
   '(290 . 1)
   '(370 . -3)
   )
      (LIST '(0 . "LAYER")
   '(100 . "AcDbSymbolTableRecord")
   '(100 . "AcDbLayerTableRecord")
   '(2 . "BEND")
   '(70 . 0)
   '(62 . 6)
   '(6 . "DASHED")
   '(290 . 1)
   '(370 . -3)
   )
      (LIST '(0 . "LAYER")
   '(100 . "AcDbSymbolTableRecord")
   '(100 . "AcDbLayerTableRecord")
   '(2 . "HATCH")
   '(70 . 0)
   '(62 . 2)
   '(6 . "Continuous")
   '(290 . 1)
   '(370 . -3)
   )
      (LIST '(0 . "LAYER")
   '(100 . "AcDbSymbolTableRecord")
   '(100 . "AcDbLayerTableRecord")
   '(2 . "MARK")
   '(70 . 0)
   '(62 . 3)
   '(6 . "Continuous")
   '(290 . 1)
   '(370 . -3)
   )
      (LIST '(0 . "LAYER")
   '(100 . "AcDbSymbolTableRecord")
   '(100 . "AcDbLayerTableRecord")
   '(2 . "LH辅助图层")
   '(70 . 0)
   '(62 . 6)
   '(6 . "Continuous")
   '(290 . 1)
   '(370 . -3)
   )
      (LIST '(0 . "LAYER")
   '(100 . "AcDbSymbolTableRecord")
   '(100 . "AcDbLayerTableRecord")
   '(2 . "LH图层")
   '(70 . 0)
   '(62 . 1)
   '(6 . "Continuous")
   '(290 . 1)
   '(370 . -3)
   )
      (LIST '(0 . "LAYER")
   '(100 . "AcDbSymbolTableRecord")
   '(100 . "AcDbLayerTableRecord")
   '(2 . "DRAW")
   '(70 . 0)
   '(62 . 7)
   '(6 . "Continuous")
   '(290 . 1)
   '(370 . -3)
   )
      (LIST '(0 . "LAYER")
   '(100 . "AcDbSymbolTableRecord")
   '(100 . "AcDbLayerTableRecord")
   '(2 . "細實線")
   '(70 . 0)
   '(62 . 2)
   '(6 . "Continuous")
   '(290 . 1)
   '(370 . 15)
   )
   )
)
(setq n1 0
n2 0
N3 0
n4 0
)
(FOREACH LST1 LST
(OR (TBLSEARCH "LTYPE" (CDR (ASSOC 6 LST1)))
(VL-CATCH-ALL-APPLY
   (QUOTE vla-Load)
   (LIST (vla-get-Linetypes
   (vla-get-ActiveDocument (vlax-get-acad-object))
)
(CDR (ASSOC 6 LST1))
(FINDFILE "acad.lin")
   )
)
)
(IF (NOT (TBLSEARCH "LAYER" (CDR (ASSOC 2 LST1))))
   (PROGN (IF (NOT (ENTMAKE LST1))
      (SETQ N1 (+ 1 N1))
      (SETQ N2 (+ 1 N2))
      )
   )
   (PROGN
(IF (= X T)
   (PROGN (SETQ OLDLST (ENTGET (TBLOBJNAME "layer" (CDR (ASSOC 2 LST1))))
      NDXF (LIST 6 62 70 290 370)
)
(IF (= XX nil)
   (SETQ N4 (+ 1 N4))
)
(FOREACH I NDXF
   (SETQ
      OLDLST (SUBST (ASSOC I LST1) (ASSOC I OLDLST) OLDLST)
   )
)
(ENTMOD OLDLST)
   )
)
   )
)
)
(ALERT (STRCAT "\n 未新建图层" (RTOS N1 2 0) "个"))
(ALERT (STRCAT "\n 新建图层" (RTOS N2 2 0) "个"))
(PRINC)
)

这是我用代码生成的lsp文件，不知道你把个#debug从哪来的

页: 1 [2]

明经CAD社区's Archiver