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

  • 相关阅读:
    动态横向(水平)合并Repeater数据行DataItem的列
    动态绑数据(Repeater控件HeaderTemplate和ItemTemplate)
    动态横向(水平)合并GridView数据行DataRow的列
    动态绑数据(GridView控件Header和ItemTemplate)
    用具体列名替代星号
    如何实现数据行转换列显示
    用LINQ获取XML节点数据
    从字符串中获取XML节点数据
    字符串创建XML文档
    根据Attribute值条件对XML文档进行修改
  • 原文地址:https://www.cnblogs.com/jordonin/p/3174168.html
Copyright © 2011-2022 走看看