---

Hallo zusammen,

ich habe folgendes Anliegen.
Ich will, dass das Makro wenn ich einen Element anklicke in der Zeichnung den Namen von dem Element nimmt (diese ist in .iam File unter iProperties/Occurrence/Name zu finden) wie man die in der Zeichnung findet weiss ich nicht, dann in die Excel datei geht den Namen findet und dann die Zelle mit dem Namen und die Nachbarzelle nimmt und in die Zeichnung als "Leader Text" einfuegt.

Das Makro muss nicht unbediengt beim anklicken von Element ausgefuert werden sondern kann auch einfach beim Ausfuehren alle "Leader Text" fuer alle Elemente einfuegen.

Ich habe schon ein passendes Makro gefunden das meiner meinung Nach nur ein bisschen geaendert werden muss:

Public Sub AddSurfaceTextureSymbol()
    ' Set a reference to the drawing document.
    ' This assumes a drawing document is active.
    Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = ThisApplication.ActiveDocument
 
    ' Check to make sure a linear dimension is selected.
    If Not TypeOf oDrawDoc.SelectSet.Item(1) Is DrawingCurveSegment Then
        MsgBox "A linear general dimension must be selected."
        Exit Sub
    End If
 
    ' Set a reference to the active sheet.
    Dim oActiveSheet As Sheet
    Set oActiveSheet = oDrawDoc.ActiveSheet
 
    ' Set a reference to the drawing dimension.
    ' This assumes that a linear general dimension is selected.
    Dim oDCS As DrawingCurveSegment
    Set oDCS = oDrawDoc.SelectSet.Item(1)
   
    ' Get the mid point of the first extension line of the dimension
    Dim oMidPoint As Point2d
    If oDCS.Parent.CurveType = kLineCurve Then
        Set oMidPoint = oDCS.Parent.MidPoint
    ElseIf oDCS.Parent.CurveType = kCircleCurve Then
        Set oMidPoint = oDCS.Parent.CenterPoint
    Else
        Set oMidPoint = oDCS.Parent.StartPoint
    End If
 
    ' Set a reference to the TransientGeometry object.
    Dim oTG As TransientGeometry
    Set oTG = ThisApplication.TransientGeometry

    Dim oLeaderPoints As ObjectCollection
    Set oLeaderPoints = ThisApplication.TransientObjects.CreateObjectCollection

    ' Create a few leader points.
    Call oLeaderPoints.Add(oTG.CreatePoint2d(oMidPoint.X + 5, oMidPoint.Y + 5))
    Call oLeaderPoints.Add(oTG.CreatePoint2d(oMidPoint.X + 5, oMidPoint.Y + 5))

    ' Create an intent and add to the leader points collection.
    ' This is the geometry that the symbol will attach to.
    Dim oGeometryIntent As GeometryIntent
    Set oGeometryIntent = oActiveSheet.CreateGeometryIntent(oDCS.Parent, kMidPointIntent)

    Call oLeaderPoints.Add(oGeometryIntent)
   
    ' Create the symbol with a leader
    Dim oSymbol As SurfaceTextureSymbol
    Set oSymbol = oActiveSheet.SurfaceTextureSymbols.Add(oLeaderPoints, _
            kMaterialRemovalRequiredSurfaceType, _
            False, _
            False, _
            False, _
            ("Ra6.3"), _
            , , , , , _
            False)
End Sub

Vielen Dank fuer Eure Hilfe im Voraus.

brauche Hilfe Dringend

Mit freundlichen Gruessen

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

---

Hi

Dein Makro ist unbrauchbar. Das zu ändern erfordert mehr Aufwand als neu schreiben.
Das Makro dürfte um einiges länger werden als dein Beispiel. Das schreibt dir vermutlich niemand mal eben so aus Langeweile. Es gibt aber Firmen die ihr Geld damit verdienen.

------------------
MfG
RK

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