Export souřadnic vybraných objektů

Produkt: AutoCAD 2006
Datum: 16.02.2006

Ukázková funkce ExportCoords ukazuje využití vlastností objektů a převod objektových typů proměnných. Funkce se dotáže na výběrovou množinu (musí být ve výkresu jedinečná, takže při každém použití původní množinu maže), poté prochází vybrané objekty a u objektů typu Point, Shape a BlockReference exportuje jejich souřadnice vložení, u objektů typu Polyline (křivka) exportuje souřadnice jejich jednotlivých vrcholů. Exportované souřadnice X-Y-Z jsou zapisovány do textového souboru C:\ExportCoords.txt (odděleny mezerami).

Funkci lze použít pro vykazování souřadnic bodových a křivkových objektů výkresu - seznam souřadnic lze např. vložit zpět do výkresu nebo načíst do Excelu.

Pro přenesení VBA kódu funkce si pomocí Alt-F11 spusťte editor VBA a zkopírujte si tento jednoduchý kód (nebo si otevřete přiložený projekt .DVB):


Public Sub ExportCoords()
 Dim AcSSet As AcadSelectionSet
 Dim pt As Variant
 On Local Error Resume Next
 If TypeName(SelectionSets("ExportCoords")) = "Nothing" Then
     SelectionSets.Add "ExportCoords"
 End If
 Set AcSSet = SelectionSets("ExportCoords")
 AcSSet.Clear
 AcSSet.SelectOnScreen
 Open "C:\ExportCoords.txt" For Output As #1 'hard coded
 If AcSSet.Count > 0 Then
      For X = 0 To AcSSet.Count - 1
          Set Object = AcSSet.Item(X)
          Select Case TypeName(Object)
              Case "IAcadPolyline", "IAcadLWPolyline", "IAcad3DPolyline"
                  For i = 0 To GetVertexCount(Object) - 1
                    OutStr = Utility.RealToString(Object.Coordinate(i)(0), acDefaultUnits, 3)
                    OutStr = OutStr & " " & Utility.RealToString(Object.Coordinate(i)(1), acDefaultUnits, 3)
                    If TypeName(Object) = "IAcad3DPolyline" Then
                        OutStr = OutStr & " " & Utility.RealToString(Object.Coordinate(i)(2), acDefaultUnits, 3)
                    Else
                        OutStr = OutStr & " " & Utility.RealToString(Object.Elevation, acDefaultUnits, 3)
                    End If
                    Print #1, OutStr
                  Next
              Case "IAcadPoint"
                    pt = Object.Coordinates
                    OutStr = Utility.RealToString(pt(0), acDefaultUnits, 3)
                    OutStr = OutStr & " " & Utility.RealToString(pt(1), acDefaultUnits, 3)
                    OutStr = OutStr & " " & Utility.RealToString(pt(2), acDefaultUnits, 3)
                    Print #1, OutStr
              Case "IAcadBlockReference2", "IAcadShape"
                    pt = Object.InsertionPoint
                    OutStr = Utility.RealToString(pt(0), acDefaultUnits, 3)
                    OutStr = OutStr & " " & Utility.RealToString(pt(1), acDefaultUnits, 3)
                    OutStr = OutStr & " " & Utility.RealToString(pt(2), acDefaultUnits, 3)
                    Print #1, OutStr
          End Select
      Next
 End If
 Close
 AcSSet.Delete
End Sub

Public Function GetVertexCount(Polyline) As Integer
On Error Resume Next
Select Case TypeName(Polyline)
  Case "IAcadLWPolyline"
      VertList = Polyline.Coordinates
      GetVertexCount = (UBound(VertList) + 1) / 2
  Case "IAcadPolyline", "IAcad3DPolyline"
      VertList = Polyline.Coordinates
      GetVertexCount = (UBound(VertList) + 1) / 3
End Select
End Function

Nyní již jen musíme vyvolat nově vytvořenou funkci. Ve spuštěném AutoCADu stiskněte Alt-F8 a v seznamu maker zvolte ExportCoords. Pro automatické spuštění lze využít např. příkaz APLČTI (_APPLOAD) a příkaz -VBARUN.