LISP用于指定图层颜色乐筑天下 - Powered by Discuz! Archiver

ASMI 发表于 2022-7-6 18:11:38

我认为Mechanical 2000是一个很遗憾的原因，但我不能用这个Autodesk产品测试它。我知道Autodesk Mechanical的对象模型与平面AutoCAD或ADT有很大区别。但我试着帮助你。请键入命令行（vl load com），然后复制到命令行：

(vlax-dump-object(vla-get-ActiveDocument(vlax-get-acad-object))t)

按F2键，获得Mechanical 2000文档的属性和方法的长列表，如下图所示（来自plane 2008）。

Command: (vl-load-com)

Command: (vlax-dump-object(vla-get-ActiveDocument(vlax-get-acad-object))t)

; IAcadDocument: An AutoCAD drawing
; Property values:
; Active (RO) = -1
; ActiveDimStyle = #<VLA-OBJECT IAcadDimStyle 0785c98c>
; ActiveLayer = #<VLA-OBJECT IAcadLayer 0785c9dc>
; ActiveLayout = #<VLA-OBJECT IAcadLayout 0785c89c>
; ActiveLinetype = #<VLA-OBJECT IAcadLineType 0785c93c>
; ActiveMaterial = #<VLA-OBJECT IAcadMaterial 0785c84c>
; ActivePViewport = AutoCAD: No active viewport in paperspace
; ActiveSelectionSet (RO) = #<VLA-OBJECT IAcadSelectionSet 0784fb1c>
; ActiveSpace = 1
; ActiveTextStyle = #<VLA-OBJECT IAcadTextStyle 0785ca2c>
; ActiveUCS = AutoCAD: Null object ID
; ActiveViewport = #<VLA-OBJECT IAcadViewport 0785ca7c>
; Application (RO) = #<VLA-OBJECT IAcadApplication 00d73d3c>
; Blocks (RO) = #<VLA-OBJECT IAcadBlocks 0785cacc>
; Database (RO) = #<VLA-OBJECT IAcadDatabase 0784fbdc>
; Dictionaries (RO) = #<VLA-OBJECT IAcadDictionaries 0785cb1c>
; DimStyles (RO) = #<VLA-OBJECT IAcadDimStyles 0785cb6c>
; ElevationModelSpace = 0.0
; ElevationPaperSpace = 0.0
; FileDependencies (RO) = #<VLA-OBJECT IAcadFileDependencies 02105024>
; FullName (RO) = ""
; Groups (RO) = #<VLA-OBJECT IAcadGroups 0785cbbc>
; Height = 776
; HWND (RO) = 66802
; Layers (RO) = #<VLA-OBJECT IAcadLayers 0785cc0c>
; Layouts (RO) = #<VLA-OBJECT IAcadLayouts 0785cc5c>
; Limits = (0.0 0.0 420.0 297.0)
; Linetypes (RO) = #<VLA-OBJECT IAcadLineTypes 0785ccac>
; Materials (RO) = #<VLA-OBJECT IAcadMaterials 0785ccfc>
; ModelSpace (RO) = #<VLA-OBJECT IAcadModelSpace2 0785cd4c>
; MSpace = AutoCAD: Invalid mode
; Name (RO) = "Drawing1.dwg"
; ObjectSnapMode = 0
; PaperSpace (RO) = #<VLA-OBJECT IAcadPaperSpace2 0785cd9c>
; Path (RO) = "C:\\Documents and Settings\\Alexander\\My Documents"
; PickfirstSelectionSet (RO) = #<VLA-OBJECT IAcadSelectionSet 0784fe1c>
; Plot (RO) = #<VLA-OBJECT IAcadPlot 02104ec4>
; PlotConfigurations (RO) = #<VLA-OBJECT IAcadPlotConfigurations 0785cdec>
; Preferences (RO) = #<VLA-OBJECT IAcadDatabasePreferences 02105204>
; ReadOnly (RO) = 0
; RegisteredApplications (RO) = #<VLA-OBJECT IAcadRegisteredApplications
0785ce3c>
; Saved (RO) = -1
; SectionManager (RO) = Exception occurred
; SelectionSets (RO) = #<VLA-OBJECT IAcadSelectionSets 0214c4e4>
; SummaryInfo (RO) = #<VLA-OBJECT IAcadSummaryInfo 02105394>
; TextStyles (RO) = #<VLA-OBJECT IAcadTextStyles 0785ce8c>
; UserCoordinateSystems (RO) = #<VLA-OBJECT IAcadUCSs 0785cedc>
; Utility (RO) = #<VLA-OBJECT IAcadUtility 0783fe6c>
; Viewports (RO) = #<VLA-OBJECT IAcadViewports 0785cf2c>
; Views (RO) = #<VLA-OBJECT IAcadViews 0785cf7c>
; Width = 1558
; WindowState = 3
; WindowTitle (RO) = "Drawing1.dwg"
; Methods supported:
; Activate ()
; AuditInfo (1)
; Close (2)
; CopyObjects (3)
; EndUndoMark ()
; Export (3)
; GetVariable (1)
; HandleToObject (1)
; Import (3)
; LoadShapeFile (1)
; New (1)
; ObjectIdToObject (1)
; Open (2)
; PurgeAll ()
; Regen (1)
; Save ()
; SaveAs (3)
; SendCommand (1)
; SetVariable (2)
; StartUndoMark ()
; Wblock (2)
T

请公布这份清单，我需要看看。

shamsam1 发表于 2022-7-6 18:17:58

对于测试，我使用autcad2000

命令：（vl load com）
命令：（vlax dump object（vla get ActiveDocument（vlax get acad object））t）
; IAcadDocument:AutoCAD图形
; 属性值：
; 有效（RO）=-1
; ActiveDimStyle=#
; 活动层=#
; 活动布局=#
; 活动线型=#
; ActivePViewport=AutoCAD：图纸空间中没有活动视口
; ActiveSelectionSet（RO）=#
; 活动空间=1
; ActiveTextStyle=#
; 活动UCS=#
; 活动视口=#
; 应用（RO）=#
; 块（RO）=#
; 数据库（RO）=#
; 词典（RO）=#
; 尺寸样式（RO）=#
; 高程模型空间=0.0
; 标高纸张空间=0.0
; 全名（RO）=“”
; 组（RO）=#
; 高度=564
; HWND（RO）=198838
; 层（RO）=#
; 布局（RO）=#
; 极限=（0.0 0.0 12.0 9.0）
; 线型（RO）=#
; 模型空间（RO）=#
; MSpace=AutoCAD：模式无效
; 名称（RO）=“Drawing1.dwg”
; ObjectSnapMode=0
; 纸张空间（RO）=#
; 路径（RO）=“D：”
; PickfirstSelectionSet（RO）=#
; 绘图（RO）=#
; 绘图配置（RO）=#
; 首选项（RO）=#
; 只读（RO）=0
; 注册应用程序（RO）=016d2084>
; 保存（RO）=0
; 选择集（RO）=#
; 文本样式（RO）=#
; 用户协调系统（RO）=#
; 公用设施（RO）=#
; 视口（RO）=#
; 视图（RO）=#
; 宽度=978
; 窗口状态=3
; WindowTitle（RO）=“Drawing1”
; 支持的方法：
; 激活（）
; 试听信息（1）
; 关闭（2）
; CopyObjects（3）
; EndUndoMark（）
; 出口（3）
; GetVariable（1）
; 把手对象（1）
; 导入（3）
; LoadShapeFile（1）
; 新（1）
; 目标对象（1）
; 打开（1）
; PurgeAll（）
; 再生（1）
; 保存（）
; SaveAs（2）
; SendCommand（1）
; SetVariable（2）
; StartUndoMark（）
; Wblock（2）

ASMI 发表于 2022-7-6 18:19:41

这太奇怪了。”缺少材质集合和“ActiveMaterial”属性我不知道如何帮助您可以打开“开发人员帮助”>“ActiveX和VBA引用”>“属性”，然后尝试查找“材质属性”。如果是，我想看看所有者对象。与普通Autocad一样：

shamsam1 发表于 2022-7-6 18:23:38

请帮我把2个lisp程序合并成一个。

添加材料和添加颜色lisp程序我想结合。

请指导我

ASMI 发表于 2022-7-6 18:30:44

有。列表“Lst”的每个成员的最后一个成员是一种颜色（0-255）。

(defun c:pumc(/ actDoc Lst sSet mLst cMat sCnt l
   Cnt mCnt eCnt cCol *error*)

(vl-load-com)

(setq Lst (list
   '("0" "Global" 4)
   '("Layer1" "Material 1" 1)
   '("Layer2" "Material 2" 6)
); end list
      ); end setq

(defun *error*(msg)
(if actDoc(vla-EndUndoMark actDoc))
(princ)
); end of error*

(vl-load-com)

(if(setq sSet(ssget "_X" '((0 . "*SOLID"))))
(progn
(setq sCnt 0 lCnt 0)
(vlax-for mat (vla-get-Materials
      (setq actDoc
      (vla-get-ActiveDocument
         (vlax-get-acad-object))))
(setq mLst(cons(vla-get-Name mat)mLst))
); end vlax-for
(vla-StartUndoMark actDoc)
(foreach itm
   (mapcar 'vlax-ename->vla-object
      (vl-remove-if 'listp
      (mapcar 'cadr(ssnamex sSet))))
   (if(setq cMat
(cadr
   (assoc
   (setq cLay(vla-get-Layer itm))Lst)))
(if(member cMat mLst)
   (if(vl-catch-all-error-p
      (vl-catch-all-apply 'vla-put-Material
(list itm cMat)))
   (setq lCnt(1+ lCnt))
   (setq sCnt(1+ sCnt))
   ); end if
   (if(not(member cMat mCnt))
   (setq mCnt(cons cMat mCnt))
   ); end if
   ); end if
(if(not(member cLay eCnt))
   (setq eCnt(cons cLay eCnt))
   ); end if
   );end if
   (if(setq cCol
(last
   (assoc
      (setq cLay(vla-get-Layer itm))Lst)))
(if(vl-catch-all-error-p
   (vl-catch-all-apply 'vla-put-Color
(list itm cCol))) nil
); end if
); end if
); end foreach
(vla-EndUndoMark actDoc)
(if(or(/= 0 lCnt)(/= 0(length mCnt))(/= 0(length eCnt)))
(progn
(princ "\n========================= ERROR LIST =========================\n")
(if(/= 0(length mCnt))
(progn
(princ "\nFollowing materials missed in drawing: \n")
(foreach mat mCnt
   (princ(strcat "\n " mat))
   ); end foreach
(princ "\n")
); end progn
); end if
   (if(/= 0(length eCnt))
(progn
(princ "\nSome solid layers missed in list: \n")
(foreach lay eCnt
   (princ(strcat "\n " lay))
   ); end foreach
(princ "\n")
); end progn
); end if
(if(/= 0 lCnt)
(princ(strcat "\n" (itoa lCnt) " were on locked layer!\n"))
); end if
(princ "\n========================== END LIST ==========================\n")
(textscr)
); end progn
); end if
   (princ(strcat "\n<<< Materials and colors are attached for "
      (itoa sCnt) " of "
      (itoa(sslength sSet)) " solids >>>"))
); end progn
(princ "\n<!> No Solids Found <!> ")
); end if
(princ)
); end of c:pumc

它在2005年不起作用。我不知道Visual LISP是如何访问版本材料集合的。可能在2007年（R 17.0）？

shamsam1 发表于 2022-7-6 18:34:05

谢谢阿斯米。。。。

页: 1 [2]

乐筑天下's Archiver