LISP用于指定图层颜色

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

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

copy

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

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

copy


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）。

copy

(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

谢谢阿斯米。。。。

[编程交流] LISP用于指定图层颜色

发表回复

精选推荐