AutoCAD开发4--添加块)

Private Sub CommandButton3_Click()

    Dim pInsertPnt As Variant

    'pInsertPnt(0) = 100.5141: pInsertPnt(1) = 34.5034: pInsertPnt(2) = 0#

   

    UserForm1.Hide

    pInsertPnt = ThisDrawing.Utility.GetPoint(, "请输入点或者在屏幕上选择一点: ")

   

    Dim pBlock As AcadBlockReference

    Dim pBlockName As String

    Dim pXDataType(0 To 1) As Integer, pXDataValue(0 To 1) As Variant

   

    pXDataType(0) = 1001: pXDataValue(0) = "SOUTH"

    pXDataType(1) = 1000

   

    Select Case ComboBox1.Value

        Case "单个旱地"

            pXDataValue(1) = "211201"

            pBlockName = "gc119"

        Case "单个稻田"

            pXDataValue(1) = "211101"

            pBlockName = "gc120"

        Case "天然草地"

            pXDataValue(1) = "214101"

            pBlockName = "gc121"

        Case "单个果园"

            pXDataValue(1) = "212101"

            pBlockName = "gc125"

        Case "单个菜地"

            pXDataValue(1) = "211401"

            pBlockName = "gc123"

        Case Else

            MsgBox "请选择合适的类型"

            Exit Sub

    End Select

   

    Set pBlock = ThisDrawing.ModelSpace.InsertBlock(pInsertPnt, pBlockName, 1, 1, 1, 0)

   

    pBlock.SetXData pXDataType, pXDataValue

   

    pBlock.Layer = "ZBTZ"

   

    ThisDrawing.Application.Update

    'UserForm1.Show

End Sub

原文地址:https://www.cnblogs.com/jordonin/p/3178975.html