[Seven]

Помогите разобраться пожалуйста !!! мне необходимо получить координаты начала линии мультивыноски.
Делаю это так:

Код:

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

Sub Точка_вставки_выноски()

    Dim Figura As AcadMLeader
    Dim To4ka As Variant
    
    ThisDrawing.Utility.GetEntity Figura, To4ka, "Ткни выноску !!!"
    
    To4ka1 = Figura.GetLeaderLineVertices(0)
    MsgBox "Точка вставки выноски " & To4ka1(0) & ", " & To4ka1(1) & ", " & To4ka1(2)

End Sub

Но на одной выноске это срабатывает, а на другой выдает ошибку =( Чертеж с выносками прикрепляю.

Справку читал, сильно читал ) до дыр, но с моим знанием английского она мне не помогла. Так и не понял зачем нужны GetLeaderIndex, GetLeaderLineIndexes. Интернет тоже перерыл но ничего путного не нашел (((

[Олег (jr.)]

Сообщение от Seven Но на одной выноске это срабатывает, а на другой выдает ошибку =( Чертеж с выносками прикрепляю.

Всегда используй при указании объекта явное указание,
сначала указывай объект как AcadEntity или AcadObject,
затем конвертируй укзатель на определённый тип объекта,
как-то так, без проверки:

Код:

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

Sub Точка_вставки_выноски()
   Dim oObj as AcadEntity
    Dim Figura As AcadMLeader
    Dim To4ka As Variant
    Dim To4ka1 As Variant
    ThisDrawing.Utility.GetEntity oObj, To4ka, "Ткни выноску !!!"
   '' ! Делай так всегда! :
    If Typeof oObj is AcadMLeader Then
    Set Figura= oObj
    Else 
    Exit Sub
    End If
    
    To4ka1 = Figura.GetLeaderLineVertices(0)
    If Not IsEmpty(To4ka1) Then
    MsgBox "Точка вставки выноски " & To4ka1(0) & ", " & To4ka1(1) & ", " & To4ka1(2)
    End If

End Sub

[Seven]

Олег (jr.) к сожалению выдает ту же ошибку ((( смотрите скрин

Чисто методом научного тыка составил программу с методом GetLeaderLineIndexes, извлекает координаты из всех выносок НО!!! )) только если они повернуты налево, если направо все писец !

Код:

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

Sub Точка_вставки_выноски()
    
    Dim oObj As AcadEntity
    Dim Figura As AcadMLeader
    Dim To4ka As Variant
    Dim To4ka1 As Variant
    Dim Klaster As Variant
    
    ThisDrawing.Utility.GetEntity oObj, To4ka, "Ткни выноску !!!"
   ' ! Хорошо буду делать =) ! :
    If TypeOf oObj Is AcadMLeader Then
        Set Figura = oObj
    Else
        Exit Sub
    End If
    
    Klaster = Figura.GetLeaderLineIndexes(0)
    To4ka1 = Figura.GetLeaderLineVertices(Klaster(0))
    
    MsgBox "Точка вставки выноски " & To4ka1(0) & ", " & To4ka1(1) & ", " & To4ka1(2)

End Sub

Кто нибудь может объяснить или дать ссылку на подробное описание этих методов GetLeaderIndex, GetLeaderLineIndexes. В справке вообще мраки, ни толкового описания ни примеров.

[Олег (jr.)]

Начни с того, как правильно создавать мультилидер:

Код:

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

Option Explicit
'' Установить :
''Tools --> Options -->  General --> Error field --> Break on Unhandled Errors
Sub CreateMleader() ' by fixo
Dim p1, p2
Dim vec(2) As Double
Dim pts(5) As Double
Dim leg As Double
Dim i As Long
Dim util As AcadUtility
Dim space As AcadModelSpace
Dim ml As AcadMLeader
With ThisDrawing
Set util = .Utility
Set space = .ModelSpace
End With

leg = 0.0625 '<-- change to your suit

On Error GoTo Err_Control

Do While True

With util
p1 = .GetPoint(, vbCrLf & "Pick starting point (or hit Enter to Exit): ")
If IsEmpty(p1) Then
Exit Do
End If
p2 = .GetPoint(p1, vbCrLf & "Pick ending point: ")

If p2(0) > p1(0) Then
pts(0) = p1(0): pts(1) = p1(1): pts(2) = p1(2)
pts(3) = p2(0): pts(4) = p2(1): pts(5) = p2(2)
Else
pts(0) = p1(0): pts(1) = p1(1): pts(2) = p1(2)
pts(3) = p2(0): pts(4) = p2(1): pts(5) = p2(2)
End If

End With

Set ml = space.AddMLeader(pts, i)

With ml
.ContentType = acMTextContent
.DogLegged = True
If p2(0) > p1(0) Then
.TextJustify = acAttachmentPointMiddleLeft
vec(0) = 1: vec(1) = 0: vec(2) = 0
Else
vec(0) = -1: vec(1) = 0: vec(2) = 0
.TextJustify = acAttachmentPointMiddleRight
End If

.LandingGap = leg
.SetDoglegDirection i, vec
.DoglegLength = leg
.TextLeftAttachmentType = acAttachmentBottomOfTopLine
.TextRightAttachmentType = acAttachmentBottomOfTopLine
.TextString = "First Line\PSecond Line"

.SetLeaderLineVertices 0, pts ' <--fix the second point location

.Update
End With

Loop

Exit_Here:
Exit Sub

Err_Control:
If Err.Description = "User input is keyword" Then
Resume Exit_Here
End If

End Sub

Тогда у тебя не должно быть проблем с GetLeaderLineIndexes

~'o'~