Add 方法 （ActiveX）
创建一个成员对象并将其添加到相应的集合中。 支持的平台：仅限 Windows 签名 - 块VBA： RetVal = object.Add(InsertionPoint, Name)
签名 - UCSVBA： RetVal = object.Add(Origin, XAxisPoint, YAxisPoint, Name)
签名 - 超链接VBA： RetVal = object.Add(Name [, Description] [, NamedLocation])
签名 - PlotConfigurationsVBA： RetVal = object.Add(Name [, ModelType])
签名 - 所有其他支持的对象VBA： RetVal = object.Add(Name)
返回值 （RetVal）类型：块、字典、DimStyle、文档、组、超链接、图层、布局、线型、材质、PlotConfiguration、PopupMenu、RegisteredApplication、SelectionSet、TextStyle、工具栏、UCS、视图、视口 新添加的对象。 言论尽管您可以使用此方法创建线型并将其添加到对象中，但将仅使用默认属性创建该线型。由于无法使用此版本的 ActiveX 自动化编辑对象的属性，因此请使用 Load 方法将现有线型加载到图形中。LinetypesLinetype 图层是使用默认颜色和线型属性创建的。默认颜色为白色，默认线型为标准线型。 文档：访问安全 URL 时，将发布一个对话框，提示用户输入必要的密码信息。如果用户尚未在浏览器中禁止此活动，则还可能显示消息框。下载文件时，AutoCAD 会创建一个临时文件进行内部处理。不要尝试访问此临时文件。此文件中的信息将在 AutoCAD 任务结束时删除。 组：不应指定过长或包含空格的名称，因为这些名称在“组”对话框中处理得不好，无法在命令行中输入。 例子VBA： Sub Example_Add()
' This example adds a block, dictionary, dimension style,
' group, layer, registered application, selection set,
' textstyle, view, viewport and UCS using the Add method.
GoSub ADDBLOCK
GoSub ADDDICTIONARY
GoSub ADDDIMSTYLE
GoSub ADDGROUP
GoSub ADDLAYER
GoSub ADDREGISTEREDAPP
GoSub ADDSELECTIONSET
GoSub ADDTEXTSTYLE
GoSub ADDVIEW
GoSub ADDVIEWPORT
GoSub ADDUCS
GoSub ADDMATERIAL
Exit Sub
ADDBLOCK:
' Create a new block called "New_Block"
Dim blockObj As AcadBlock
' Define the block
Dim insertionPnt(0 To 2) As Double
insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
' Add the block to the blocks collection
Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "New_Block")
MsgBox blockObj.name & " has been added." & vbCrLf & _
"Origin: " & blockObj.origin(0) & ", " & blockObj.origin(1) _
& ", " & blockObj.origin(2), , "Add Example"
Return
ADDDICTIONARY:
' Create a new dictionary called "New_Dictionary"
Dim dictObj As AcadDictionary
' Add the dictionary to the dictionaries collection
Set dictObj = ThisDrawing.Dictionaries.Add("New_Dictionary")
MsgBox dictObj.name & " has been added.", , "Add Example"
Return
ADDDIMSTYLE:
' Create a new dimension style called "New_Dimstyle" in current drawing
Dim DimStyleObj As AcadDimStyle
' Add the dimstyle to the dimstyles collection
Set DimStyleObj = ThisDrawing.DimStyles.Add("New_Dimstyle")
MsgBox DimStyleObj.name & " has been added.", , "Add Example"
Return
ADDGROUP:
' Create a new group called "New_Group" in current drawing
Dim groupObj As AcadGroup
' Add the group to the groups collection
Set groupObj = ThisDrawing.Groups.Add("New_Group")
MsgBox groupObj.name & " has been added.", , "Add Example"
Return
ADDLAYER:
' This example creates a new layer called "New_Layer"
Dim layerObj As AcadLayer
' Add the layer to the layers collection
Set layerObj = ThisDrawing.Layers.Add("New_Layer")
' Make the new layer the active layer for the drawing
ThisDrawing.ActiveLayer = layerObj
' Display the status of the new layer
MsgBox layerObj.name & " has been added." & vbCrLf & _
"LayerOn Status: " & layerObj.LayerOn & vbCrLf & _
"Freeze Status: " & layerObj.Freeze & vbCrLf & _
"Lock Status: " & layerObj.Lock & vbCrLf & _
"Color: " & layerObj.Color, , "Add Example"
Return
ADDREGISTEREDAPP:
' Create a registered application named "New_RegApp" in current drawing
Dim RegAppObj As AcadRegisteredApplication
' Add the registered application to the registered applications collection
Set RegAppObj = ThisDrawing.RegisteredApplications.Add("New_RegApp")
MsgBox RegAppObj.name & " has been added.", , "Add Example"
Return
ADDSELECTIONSET:
' Create a selectionset named "New_SelectionSet" in current drawing
Dim ssetObj As AcadSelectionSet
' Add the selection set to the selection sets collection
Set ssetObj = ThisDrawing.SelectionSets.Add("New_SelectionSet")
MsgBox ssetObj.name & " has been added." & vbCrLf & _
"The number of items in the selection set is " & ssetObj.count _
, , "Add Example"
Return
ADDTEXTSTYLE:
' Create a textstyle named "New_Textstyle" in current drawing
Dim txtStyleObj As AcadTextStyle
' Add the textstyle to the textstyles collection
Set txtStyleObj = ThisDrawing.TextStyles.Add("New_Textstyle")
MsgBox txtStyleObj.name & " has been added." & vbCrLf & _
"Height: " & txtStyleObj.height & vbCrLf & _
"Width: " & txtStyleObj.width, , "Add Example"
Return
ADDVIEW:
' Create a view named "New_View" in current drawing
Dim viewObj As AcadView
' Add the view to the views collection
Set viewObj = ThisDrawing.Views.Add("New_View")
MsgBox viewObj.name & " has been added." & vbCrLf & _
"Height: " & viewObj.height & vbCrLf & _
"Width: " & viewObj.width, , "Add Example"
Return
ADDVIEWPORT:
' Create a viewport named "New_Viewport" in current drawing
Dim vportObj As AcadViewport
' Add the viewport to the viewports collection
Set vportObj = ThisDrawing.Viewports.Add("New_Viewport")
MsgBox vportObj.name & " has been added." & vbCrLf & _
"GridOn Status: " & vportObj.GridOn & vbCrLf & _
"OrthoOn Status: " & vportObj.OrthoOn & vbCrLf & _
"SnapOn Status: " & vportObj.SnapOn, , "Add Example"
Return
ADDUCS:
' Create a UCS named "New_UCS" in current drawing
Dim ucsObj As AcadUCS
Dim origin(0 To 2) As Double
Dim xAxisPnt(0 To 2) As Double
Dim yAxisPnt(0 To 2) As Double
' Define the UCS
origin(0) = 4#: origin(1) = 5#: origin(2) = 3#
xAxisPnt(0) = 5#: xAxisPnt(1) = 5#: xAxisPnt(2) = 3#
yAxisPnt(0) = 4#: yAxisPnt(1) = 6#: yAxisPnt(2) = 3#
' Add the UCS to the UserCoordinatesSystems collection
Set ucsObj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPnt, yAxisPnt, "New_UCS")
MsgBox ucsObj.name & " has been added." & vbCrLf & _
"Origin: " & ucsObj.origin(0) & ", " & ucsObj.origin(1) _
& ", " & ucsObj.origin(2), , "Add Example"
Return
ADDMATERIAL:
Dim oMaterial As AcadMaterial
Dim oMaterials As AcadMaterials
Set oMaterial = ThisDrawing.Materials.Add("TestMaterial")
oMaterial.Description = "This example demonstrates how to add a material to a database."
ThisDrawing.ActiveMaterial = oMaterial
' Display the status of the new layer
MsgBox oMaterial.Name & " has been added." & vbCrLf & _
"Name: " & oMaterial.Name & vbCrLf & vbCrLf & _
"Description: " & vbCrLf & vbCrLf & _
oMaterial.Description
Return
End Sub
可视化 LISP： (vl-load-com)
(defun c:Example_Add()
;; This example adds a block, dictionary, dimension style,
;; group, layer, registered application, selection set,
;; textstyle, view, viewport and UCS using the Add method.
(setq acadObj (vlax-get-acad-object))
(setq doc (vla-get-ActiveDocument acadObj))
;; ADDBLOCK:
;; Create a new block called "New_Block"
;; Define the insertion point
(setq insertionPnt (vlax-3d-point 0 0 0))
;; Add the block to the blocks collection
(setq blocks (vla-get-Blocks doc))
(setq blockObj (vla-Add blocks insertionPnt "New_Block"))
(alert (strcat (vla-get-Name blockObj) " has been added."
"\nOrigin: " (rtos (vlax-safearray-get-element (vlax-variant-value (vla-get-Origin blockObj)) 0) 2 2) ", "
(rtos (vlax-safearray-get-element (vlax-variant-value (vla-get-Origin blockObj)) 1) 2 2) ", "
(rtos (vlax-safearray-get-element (vlax-variant-value (vla-get-Origin blockObj)) 2) 2 2)
)
)
;; ADDDICTIONARY:
;; Create a new dictionary called "New_Dictionary"
;; Add the dictionary to the dictionaries collection
(setq dictionaries (vla-get-Dictionaries doc))
(setq dictObj (vla-Add dictionaries "New_Dictionary"))
(alert (strcat (vla-get-Name dictObj) " has been added."))
;; ADDDIMSTYLE:
;; Create a new dimension style called "New_Dimstyle" in current drawing
;; Add the dimstyle to the dimstyles collection
(setq dimStyles (vla-get-DimStyles doc))
(setq dimStyleObj (vla-Add dimStyles "New_Dimstyle"))
(alert (strcat (vla-get-Name dimStyleObj) " has been added."))
;; ADDGROUP:
;; Create a new group called "New_Group" in current drawing
;; Add the group to the groups collection
(setq groups (vla-get-Groups doc))
(setq groupObj (vla-Add dimStyles "New_Group"))
(alert (strcat (vla-get-Name groupObj) " has been added."))
;; ADDLAYER:
;; This example creates a new layer called "New_Layer"
;; Add the layer to the layers collection
(setq layers (vla-get-Layers doc))
(setq layerObj (vla-Add layers "New_Layer"))
;; Make the new layer the active layer for the drawing
(vla-put-ActiveLayer doc layerObj)
;; Display the status of the new layer
(alert (strcat (vla-get-Name layerObj) " has been added."
"\nLayerOn Status: " (if (= (vla-get-LayerOn layerObj) :vlax-true) "1" "0")
"\nFreeze Status: " (if (= (vla-get-Freeze layerObj) :vlax-true) "1" "0")
"\nLock Status: " (if (= (vla-get-Lock layerObj) :vlax-true) "1" "0")
"\nColor: " (itoa (vla-get-Color layerObj))
)
)
;; ADDREGISTEREDAPP:
;; Create a registered application named "New_RegApp" in current drawing
;; Add the registered application to the registered applications collection
(setq regApps (vla-get-RegisteredApplications doc))
(setq regAppObj (vla-Add regApps "New_RegApp"))
(alert (strcat (vla-get-Name regAppObj) " has been added."))
;; ADDSELECTIONSET:
;; Create a selectionset named "New_SelectionSet" in current drawing
;; Add the selection set to the selection sets collection
(setq ssets (vla-get-SelectionSets doc))
(setq ssetObj (vla-Add ssets "New_SelectionSet"))
(alert (strcat (vla-get-Name ssetObj) " has been added."
"\nThe number of items in the selection set is " (itoa (vla-get-Count ssetObj))
)
)
;; ADDTEXTSTYLE:
;; Create a textstyle named "New_Textstyle" in current drawing
;; Add the textstyle to the textstyles collection
(setq textStyles (vla-get-TextStyles doc))
(setq txtStyleObj (vla-Add textStyles "New_Textstyle"))
(alert (strcat (vla-get-Name txtStyleObj) " has been added."
"\nHeight: " (rtos (vla-get-Height txtStyleObj) 2 2)
"\nWidth: " (rtos (vla-get-Width txtStyleObj) 2 2)
)
)
;; ADDVIEW:
;; Create a view named "New_View" in current drawing
;; Add the view to the views collection
(setq views (vla-get-Views doc))
(setq viewObj (vla-Add views "New_View"))
(alert (strcat (vla-get-Name viewObj) " has been added."
"\nHeight: " (rtos (vla-get-Height viewObj) 2 2)
"\nWidth: " (rtos (vla-get-Width viewObj) 2 2)
)
)
;; ADDVIEWPORT:
;; Create a viewport named "New_Viewport" in current drawing
;; Add the viewport to the viewports collection
(setq viewports (vla-get-Viewports doc))
(setq vportObj (vla-Add viewports "New_Viewport"))
(alert (strcat (vla-get-Name vportObj) " has been added."
"\nGridOn Status: " (if (= (vla-get-GridOn vportObj) :vlax-true) "1" "0")
"\nOrthoOn Status: " (if (= (vla-get-OrthoOn vportObj) :vlax-true) "1" "0")
"\nSnapOn Status: " (if (= (vla-get-SnapOn vportObj) :vlax-true) "1" "0")
)
)
;; ADDUCS:
;; Create a UCS named "New_UCS" in current drawing
;; Define the UCS
(setq origin (vlax-3d-point 4 5 3)
xAxisPnt (vlax-3d-point 5 5 3)
yAxisPnt (vlax-3d-point 4 6 4))
;; Add the UCS to the UserCoordinatesSystems collection
(setq UCSs (vla-get-UserCoordinateSystems doc))
(setq ucsObj (vla-Add UCSs origin xAxisPnt yAxisPnt "New_UCS"))
(alert (strcat (vla-get-Name ucsObj) " has been added."
"\nOrigin: " (rtos (vlax-safearray-get-element (vlax-variant-value (vla-get-Origin ucsObj)) 0) 2 2) ", "
(rtos (vlax-safearray-get-element (vlax-variant-value (vla-get-Origin ucsObj)) 1) 2 2) ", "
(rtos (vlax-safearray-get-element (vlax-variant-value (vla-get-Origin ucsObj)) 2) 2 2)
)
)
;; ADDMATERIAL:
;; Creates a material named "New_UCS" in the current drawing
(setq oMaterials (vla-get-Materials doc))
(setq oMaterial (vla-Add oMaterials "TestMaterial"))
(vla-put-Description oMaterial "This example demonstrates how to add a material to a database.")
(vla-put-ActiveMaterial doc oMaterial)
;; Display information about the material
(alert (strcat (vla-get-Name oMaterial) " has been added."
"\nName: " (vla-get-Name oMaterial)
"\nDescription: " (vla-get-Description oMaterial)
)
)
)
|
|Archiver|CAD开发者社区
( 苏ICP备2022047690号-1 苏公网安备32011402011833)
GMT+8, 2025-3-14 07:22
Powered by Discuz! X3.4
Copyright © 2001-2021, Tencent Cloud.
