---

Hallo Forumsgemeinde,

ich hab' mir mal vor einiger Zeit ein Makro geschrieben, das auch wunderbar funktionierte. Dieses ermittelt mittels "Loop/Do-Until" an welcher Stelle ein spezifischer Stil gespeichert ist.
Heute benötige ich das Makro mal wieder nach Monaten ...es läuft auch ohne Fehler durch, aber geht in keine der "Do Until/Loop"-Schleifen rein. warum nicht? weiß das jemand? hier mal der Code:

Dim tAligStyle As AeccAlignmentStyle
    Set oAlignments = oAeccDoc.AlignmentsSiteless
   
    Const AeccProgID As String = "AeccXUILand.AeccApplication.8.0"
    Dim oAcadApp As AcadApplication
    Dim oAeccDocDB As AeccDatabase
   
    Set oAcadApp = ThisDrawing.Application
    Set oAeccApp = oAcadApp.GetInterfaceObject(AeccProgID)
    Set oAeccDoc = oAeccApp.ActiveDocument
    Set oAeccDocDB = oAeccDoc.Database
   
    Dim oSite As AeccSite
    Dim oAlignmentSiteless As AeccAlignmentsSiteless
    Dim oProfileView As AeccProfileView
   
    Dim oProfiles As AeccProfiles
    Dim oProfile As AeccProfile
   
    Dim oSurf As AeccSurface
    Set oSurf = oAeccDoc.Surfaces.Item(l)
   
    Dim oProfileStyle As AeccProfileStyle
   
    Dim oProfileViewStyle As AeccProfileViewStyle

[...]

i = 0: j = 0
    ' Ermittlung der Position des LabelStyleSets innerhalb tAeccDoc
    Do Until oAeccDoc.AlignmentLabelStyleSets.Item(i).Name = "Profilschnitt"
        i = i + 1
    Loop
    'Ermittlung der Position des AlignmentStyles innerhalb tAeccDoc
    Do Until oAeccDoc.AlignmentStyles.Item(j).Name = "Standard"
        j = j + 1
    Loop
    'Style des Profilschnittes auswählen
    l = 0
    Do Until oAeccDoc.LandProfileStyles.Item(l).Name = "Profilschnitt"
        l = l + 1
    Loop
    Set oProfileStyle = oAeccDoc.LandProfileStyles.Item(l)
    'Style des höhenplanes wählen
    M = 0
    Do Until oAeccDoc.ProfileViewStyles.Item(M).Name = "Höhenplanstil1"
        M = M + 1
    Loop
    Set oProfileViewStyle = oAeccDoc.ProfileViewStyles.Item(M)
    'Ermittlung der Position des Layers
    n = 0
    Do Until ThisDrawing.Layers.Item(n).Name = "ETS_Achsen"
        n = n + 1
    Loop

die letzte Schleife "Do until thisdrawing..." funktioniert übrigens. es scheint also etwas mit den Civil-eigenen ACAD-Objekten zu tun zu haben

------------------

http://www.stupidedia.org/stupi/Rechter_Winkel

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

---

Bei mir läufts prinzipiell (zumindest durchläuft das Makro auch die DO Until Anweisung).
Da ich jedoch keine Beispielzeichnung mit entspr. Stilen habe, stürzt das Makro gleich ab, da es kein Errorhandling gibt. Wenn z.b.
i höher als  oAeccDoc.AlignmentLabelStyleSets.Item(i).Name = "Profilschnitt" wird, was zwangsläufig passiert, wenn es keinen AlignmentLabelStyleSet namens "Profilschnitt" gibt.
Kurz getestet mit Civil 3D 2012 Sp1.

------------------
Mit freundlichem Gruß

Udo Hübner
www.CAD-Huebner.de

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