---

Hallo Zusammen

Ich möchte ein Symbol mit Leader an ein FeatureControlFrame  hängen.
Leider hatte ich noch keinen Erfolg, weiss jemand wie es geht mit VBA?

Folgendes habe ich Versucht:

Code:

---

Dim oFrame As FeatureControlFrame
            Set oFrame = oSelection.Item(i)
            Set pPos = oTG.CreatePoint2d(oFrame.Position.X, oFrame.Position.Y)
            pPos.X = pPos.X + 0.2
            pPos.Y = pPos.Y + 0.2
            Call oLeaderPoints.Add(pPos)
            Call oLeaderPoints.Add(oFrame.Leader.AllLeafNodes.Item(1).AttachedEntity)
  Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = ThisApplication.ActiveDocument

    Dim oSketchedSymbolDef As SketchedSymbolDefinition
    Set oSketchedSymbolDef = oDrawDoc.SketchedSymbolDefinitions.Item(sSketchSymbolName)

    Dim oSheet As Sheet
    Set oSheet = oDrawDoc.ActiveSheet
   
    Dim sPromptStrings(0 To 0) As String
    sPromptStrings(0) = sText

    Dim oSketchedSymbol As SketchedSymbol
    Set oSketchedSymbol = oSheet.SketchedSymbols.AddWithLeader(oSketchedSymbolDef, oLeaderPoints, 0, 1, sPromptStrings)
    oSketchedSymbol.LeaderVisible = False

---

Bei einem Geometrie Objekt geht es so:

Code:

---

Dim oDimension As DrawingDimension
            Set oDimension = oSelection.Item(i)
            Set pPos = oTG.CreatePoint2d(oDimension.text.RangeBox.MaxPoint.X, oDimension.text.RangeBox.MaxPoint.Y)
            pPos.X = pPos.X + 0.2
            pPos.Y = pPos.Y + 0.2
            Call oLeaderPoints.Add(pPos)
            Call oLeaderPoints.Add(getIntentFromGeometry(oDimension))
Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = ThisApplication.ActiveDocument

    Dim oSketchedSymbolDef As SketchedSymbolDefinition
    Set oSketchedSymbolDef = oDrawDoc.SketchedSymbolDefinitions.Item(sSketchSymbolName)

    Dim oSheet As Sheet
    Set oSheet = oDrawDoc.ActiveSheet
   
    Dim sPromptStrings(0 To 0) As String
    sPromptStrings(0) = sText

    Dim oSketchedSymbol As SketchedSymbol
    Set oSketchedSymbol = oSheet.SketchedSymbols.AddWithLeader(oSketchedSymbolDef, oLeaderPoints, 0, 1, sPromptStrings)
    oSketchedSymbol.LeaderVisible = False

Public Function getIntentFromGeometry(oDim As DrawingDimension)
  Dim intent As GeometryIntent
  Dim oGeometryIntent As GeometryIntent
  Dim oMidPoint As Object
            Dim oLinearDim As LinearGeneralDimension
            Set oLinearDim = oDim
            Set oMidPoint = oLinearDim.DimensionLine.MidPoint
            Set oGeometryIntent = ThisApplication.ActiveDocument.ActiveSheet.CreateGeometryIntent(oLinearDim, oMidPoint)
            Set getIntentFromGeometry = oGeometryIntent
   
End Function

---

Danke Gruss Sascha

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP