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?