使用 VBA 以外的其它编程语言

Sub Example_Add()
    ' 该示例使用 Add 方法添加块、词典、标注样式、组合、图层、
    ' 注册应用程序、选择集、文字样式、视图、视口和 UCS。
    
    GoSub ADDBLOCK
    GoSub ADDDICTIONARY
    GoSub ADDDIMSTYLE
    GoSub ADDGROUP
    GoSub ADDLAYER
    GoSub ADDREGISTEREDAPP
    GoSub ADDSELECTIONSET
    GoSub ADDTEXTSTYLE
    GoSub ADDVIEW
    GoSub ADDVIEWPORT
    GoSub ADDUCS
    Exit Sub
    
ADDBLOCK:
    ' 创建名称为"New_Block"的新块
    Dim blockObj As AcadBlock
    
    ' 定义块
    Dim insertionPnt(0 To 2) As Double
    insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
    
    ' 添加块到块集合中
    Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "New_Block")
    MsgBox blockObj.name & " 已经添加。" & vbCrLf & _
            "原点: " & blockObj.origin(0) & ", " & blockObj.origin(1) _
            & ", " & blockObj.origin(2), , "Add 示例"
    Return
    
ADDDICTIONARY:
    ' 创建名称为"New_Dictionary"的新词典
    Dim dictObj As AcadDictionary
    
    ' 添加词典到词典集合中
    Set dictObj = ThisDrawing.Dictionaries.Add("New_Dictionary")
    MsgBox dictObj.name & " 已经添加。", , "Add 示例"
    Return

ADDDIMSTYLE:
    ' 在当前图形中合建名称为"New_Dimstyle"的新标注样式
    Dim DimStyleObj As AcadDimStyle
    
    ' 添加标注到标注集合中
    Set DimStyleObj = ThisDrawing.DimStyles.Add("New_Dimstyle")
    MsgBox DimStyleObj.name & " 已经添加。", , "Add 示例"
    Return
    
ADDGROUP:
    ' 在当前图形中创建名称为"New_Group"的新组合
    Dim groupObj As AcadGroup
    
    ' 添加组合到组合集合中
    Set groupObj = ThisDrawing.Groups.Add("New_Group")
    MsgBox groupObj.name & " 已经添加。", , "Add 示例"
    Return
    
ADDLAYER:
    ' 创建名称为"New_Layer"的新图层
    Dim layerObj As AcadLayer
    
    ' 添加图层到图层集合中
    Set layerObj = ThisDrawing.Layers.Add("New_Layer")
    
    ' 使新图层成为图形中活动的图层
    ThisDrawing.ActiveLayer = layerObj
    
    ' Display the status of the new layer
     MsgBox layerObj.name & " 已经添加。" & vbCrLf & _
            "开关状态: " & layerObj.LayerOn & vbCrLf & _
            "冻结状态: " & layerObj.Freeze & vbCrLf & _
            "锁定状态: " & layerObj.Lock & vbCrLf & _
            "颜色: " & layerObj.Color, , "Add 示例"
    Return
    
ADDREGISTEREDAPP:
    ' 在当前图形中合建名称为"New_RegApp"的应用程序
    Dim RegAppObj As AcadRegisteredApplication
    
    ' 添加注册应用程序到注册应用程序集合中
    Set RegAppObj = ThisDrawing.RegisteredApplications.Add("New_RegApp")
    MsgBox RegAppObj.name & " 已经添加。", , "Add 示例"
    Return

ADDSELECTIONSET:
    ' 在当前图形中创建名称为"New_SelectionSet"的选择集
    Dim ssetObj As AcadSelectionSet
    
    ' 添加选择集到选择集集合中
    Set ssetObj = ThisDrawing.SelectionSets.Add("New_SelectionSet")
    MsgBox ssetObj.name & " 已经添加。" & vbCrLf & _
           "在该选择集中的项目数量为 " & ssetObj.count _
           , , "Add 示例"
    Return
    
ADDTEXTSTYLE:
    ' 在当前图形中创建名称为 "New_Textstyle"的文字样式
    Dim txtStyleObj As AcadTextStyle
    
    ' 添加文字样式到文字样式集合中
    Set txtStyleObj = ThisDrawing.TextStyles.Add("New_Textstyle")
    MsgBox txtStyleObj.name & " 已经添加。" & vbCrLf & _
           "高度: " & txtStyleObj.height & vbCrLf & _
           "宽度: " & txtStyleObj.width, , "Add 示例"
    Return
    
ADDVIEW:
    ' 在当前图形中创建名称为"New_View"的视图
    Dim viewObj As AcadView
    
    ' 添加视图到视图集合中
    Set viewObj = ThisDrawing.Views.Add("New_View")
    MsgBox viewObj.name & " 已经添加。" & vbCrLf & _
           "高度: " & viewObj.height & vbCrLf & _
           "宽度: " & viewObj.width, , "Add 示例"
    Return
    
ADDVIEWPORT:
    ' 在当前图形中创建名称为"New_Viewport"的视口
    Dim vportObj As AcadViewport
    
    ' 添加视口到视口集合中
    Set vportObj = ThisDrawing.Viewports.Add("New_Viewport")
    MsgBox vportObj.name & " 已经添加。" & vbCrLf & _
           "GridOn 状态: " & vportObj.GridOn & vbCrLf & _
           "OrthoOn 状态: " & vportObj.OrthoOn & vbCrLf & _
           "SnapOn 状态: " & vportObj.SnapOn, , "Add 示例"
    Return
    
ADDUCS:
    ' 在当前图形中创建名称为"New_UCS"的用户坐标系
    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
    
    ' 定义用户坐标系
    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#
    
    ' 添加 UCS 到 UserCoordinatesSystems 集合中
    Set ucsObj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPnt, yAxisPnt, "New_UCS")
    MsgBox ucsObj.name & " 已经添加。" & vbCrLf & _
            "原点: " & ucsObj.origin(0) & ", " & ucsObj.origin(1) _
            & ", " & ucsObj.origin(2), , "Add 示例"
    Return
    
End Sub