[Тензор]

Здравствуйте. Есть чертеж на нем есть 2 сплайна и 2 дуги. Есть ли какой-нибудь способ получить их имена с помощью VBA?

[Олег (jr.)]

Сообщение от Тензор Здравствуйте. Есть чертеж на нем есть 2 сплайна и 2 дуги. Есть ли какой-нибудь способ получить их имена с помощью VBA?

Например так (отобразит некоторые свойства
в окне Immediate для наглядности)

Код:

[Выделить все]

Option Explicit

Sub LoopTroughDWG()
Dim oEnt As AcadEntity
Dim oLayout As AcadLayout
Dim oLine As AcadLine
Dim oLwPoly As AcadLWPolyline
Dim oPoly As AcadPolyline
Dim oArc As AcadArc
Dim oCircle As AcadCircle
Dim oEllipse As AcadEllipse
Dim oSpline As AcadSpline
Dim ftype(0) As Integer
Dim fdata(0) As Variant
Dim dxfCode, dxfValue

     Dim oSset As AcadSelectionSet
          With ThisDrawing.SelectionSets
               While .Count > 0
                    .Item(0).Delete
               Wend
          Set oSset = .Add("NewSset")
          End With
          
ftype(0) = 0: fdata(0) = "LINE,SPLINE,LWPOLYLINE,POLYLINE,ARC,CIRCLE,ELLIPSE" '<--"*LINE,..."
dxfCode = ftype: dxfValue = fdata
oSset.Select acSelectionSetAll, , , dxfCode, dxfValue

MsgBox "Selected: " & oSset.Count & " entities" '<-- debug only

For Each oEnt In oSset
Set oLayout = ThisDrawing.ObjectIdToObject(oEnt.OwnerID).Layout
Debug.Print "Layout Name: " & oLayout.Name & ": " & vbCr & _
"Object Name: " & oEnt.ObjectName

If TypeOf oEnt Is AcadLine Then
Set oLine = oEnt
Debug.Print "Start Point: " & oLine.StartPoint(0) & " ; " & oLine.StartPoint(1)  '<-- debug only
ElseIf TypeOf oEnt Is AcadSpline Then
Set oSpline = oEnt
Debug.Print "Start Tangent: " & oSpline.StartTangent(0) & " ; " & oSpline.StartTangent(1)   '<-- debug only
ElseIf TypeOf oEnt Is AcadPolyline Then
Set oPoly = oEnt
Debug.Print "Start Point: " & oPoly.Coordinate(0)(0) & " ; " & oPoly.Coordinate(0)(1) '<-- debug only
ElseIf TypeOf oEnt Is AcadLWPolyline Then
Set oLwPoly = oEnt
Debug.Print "Start Point: " & oLwPoly.Coordinate(0)(0) & " ; " & oLwPoly.Coordinate(0)(1) '<-- debug only
ElseIf TypeOf oEnt Is AcadCircle Then
Set oCircle = oEnt
Debug.Print "Radius: " & oCircle.Radius '<-- debug only
ElseIf TypeOf oEnt Is AcadArc Then
Set oArc = oEnt
Debug.Print "Arc Length: " & oArc.ArcLength '<-- debug only
ElseIf TypeOf oEnt Is AcadEllipse Then
Set oEllipse = oEnt
Debug.Print "Start Angle: " & oEllipse.StartAngle '<-- debug only
'' etc etc
End If

Next oEnt

End Sub

~'J'~

[Тензор]

Олег (jr.)

Огромное спасибо!!! Все работает!!!!

[Олег (jr.)]

Сообщение от Тензор Олег (jr.) Огромное спасибо!!! Все работает!!!!

Неужели???
Успехов

~'J'~