Add Example |
Using Programming Languages other than 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
Comments? |