zoukankan      html  css  js  c++  java
  • AutoCAD开发1---获取块属性

    Private Sub CommandButton1_Click()

        Dim pEntity As AcadObject

        Dim pBlock As AcadBlockReference

        Dim pPolyline As AcadLWPolyline

        Dim pSlct As AcadSelectionSet

     

        ' Entity 选择集存在,则删除选择集,删除后并添加

        For i = 0 To ThisDrawing.SelectionSets.Count - 1

            If ThisDrawing.SelectionSets.Item(i).Name = "Entity" Then

                Set pSlct = ThisDrawing.SelectionSets.Item(i)

                pSlct.Delete

            End If

        Next i

        Set pSlct = ThisDrawing.SelectionSets.Add("Entity")

       

        '隐藏窗体,并用 SelectOnScreen 方法选择

        UserForm1.Hide

        pSlct.SelectOnScreen

       

        '定义要获取的数据的类型和数据载体

        Dim pXDataType As Variant

        Dim pXDatavlaue As Variant

       

        '定义块的插入点,坐标存放数组

        Dim pInsertPt As Variant

        Dim pCoords As Variant

        Dim sCoor As String

        

        For Each pEntity In pSlct

       

            'Debug.Print pEntity.ObjectName

           

            If pEntity.ObjectName = "AcDbBlockReference" Then

               

                Set pBlock = pEntity

               

                pBlock.GetXData "SOUTH", pXDataType, pXDatavlaue

               

                pInsertPt = pBlock.InsertionPoint

               

                'Debug.Print pXDataType(0) & "," & pXDataType(1)

                'Debug.Print pXDatavlaue(1) & "," & pInsertPt(0) & "," & pInsertPt(1) & "," & pBlock.Linetype & "," & pBlock.LinetypeScale & "," & pBlock.Lineweight & "," & pBlock.HasAttributes & "," & pBlock.XScaleFactor & "," & pBlock.YScaleFactor&; "," & pBlock.ZScaleFactor

                'Debug.Print pBlock.Name & "," & pBlock.Layer

                'Debug.Print pBlock.ObjectID & "," & pBlock.Handle & "," & pXDatavlaue(1) & "," & pInsertPt(0) & "," & pInsertPt(1)

                'Debug.Print pBlock.Linetype & "," & pBlock.LinetypeScale & "," & pBlock.Lineweight

                'Debug.Print pBlock.XScaleFactor & "," & pBlock.YScaleFactor & "," & pBlock.ZScaleFactor

                'Debug.Print

               

                MsgBox "  :" & pBlock.Name & Chr(13) & "所在层:" & pBlock.Layer & Chr(13) & "  :" & pXDatavlaue(1) & Chr(13) & "  :" & Format(pInsertPt(0), "0.0000") & "," & Format(pInsertPt(1), "0.0000")

               

            ElseIf pEntity.ObjectName = "AcDbPolyline" Then

               

                Set pPolyline = pEntity

                pPolyline.GetXData "SOUTH", pXDataType, pXDatavlaue

               

                pCoords = pPolyline.Coordinates

               

                'Debug.Print pXDatavlaue(1) & "," & pPolyline.ObjectID

               

                For j = 0 To UBound(pCoords)

                    If j Mod 2 = 0 Then

                        'Debug.Print sCoor

                        sCoor = ""

                    End If

                    sCoor = sCoor & pCoords(j) & ","

                Next j

                Debug.Print

            End If

        Next pEntity

        pSlct.Delete

        'UserForm1.Show

    End Sub

  • 相关阅读:
    php简单实现MVC
    windows获取窗口句柄
    UPX编译及so加固
    Markdown: Syntax
    Markdown: Syntax Text
    BIOS将MBR读入0x7C00地址处(x86平台下)
    TPFanControl.ini
    深入浅出GNU X86-64 汇编
    CPU vector operations
    Google开源项目风格指南
  • 原文地址:https://www.cnblogs.com/jordonin/p/3174168.html
Copyright © 2011-2022 走看看