---

Hallo zusammen,

ich habe mehrere Höhenpläne (erstellt aus Achsen). Für weitere Arbeiten möchte ich mir ein Makro programmieren, bei dem ich nach Aufruf des Makros einen dieser Höhenpläne per Mausclick auswähle und dann bestimmte Informationen dieses Höhenplans erhalte. Nach der Auswahl sollen mir z.B. die Ausdehnung des Höhenplanes in der Zeichnung (minimale und maximale x- u. y-Koordinate - quasi wie bei einer BoundingBox, die Achse mit der der Höhenplan erstellt wurde und die minimale Höhe, die in der grafischen Darstellung als Achsbeschriftung verwendet wird, ausgegeben werden.
Ich habe mir grad den "civil_api_developers_guide" durchgelesen, da steht ja schon einiges drin, allerdings nur zu Erstellung von Höhenplänen mit VBA, bei mir ist die Aufgabenstellung ja genau andersrum. Den Höhenplan habe ich ja schon, ich möchte ja o.a. Informationen des Höhenplanes per Mauscklick rausfinden.
1. geht das überhaupt?
2. wenn ja: wie?

...ich freue mich auf eure Anregungen und Tips 

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

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

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

---

Hi,

>> Nach der Auswahl sollen mir z.B. die Ausdehnung des Höhenplanes in der Zeichnung
>> (minimale und maximale x- u. y-Koordinate - quasi wie bei einer BoundingBox

Und geht GetBoundingBox nicht? Ich möcht jetzt ohne Codevorlage nicht zu schreiben beginnen, wenn Du es schon probiert hast. Wenn Du es noch nicht probiert hast, dann probiers bitte und berichte die Erfahrungen dazu. 

BTW: Dir ist schon klar, dass sich die BoundingBox ändert, wenn Du den Maßstab (im Ansichtsfenster eines Layouts) änderst? 

Aus dem Satz werd ich auch nicht ganz schlau:
>> die minimale Höhe, die in der grafischen Darstellung als Achsbeschriftung verwendet wird

Mir ist dabei nicht klar, was die minimale Höhe der Achsbeschriftung in einem Höhenplan ist, denn eine Achse hat keine Höhe, maximal der von der Achse abhängige Längsschnitt.
...und davon kann es wiederum mehrere in einem Höhenplan geben.

Sorry, Fragen über Fragen.

- alfred -

------------------
www.hollaus.at

---

Hallo Alfred,

das Problem ist nicht die BoundingBox, was ich benötigen würde, wären Informationen wie ich auf Eigenschaften eines Objektes der Art AeccProfile zugreifen kann, bzw. auf welche Eigenschaften man zugreifen kann.
gibt's da irgendwo eine Dokumentation? dieser civil_api_developersguide gibt da nämlich nichts her (zumindest mir nicht).
Ich bräuchte z.B. Informationen wie
AeccProfile.Einfügepunkt
AeccProfile.Basishöhe
AeccProfile.zugrundeliegende_Achse

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

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

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

---

Hi,

hier ein Beispiel, wie Du an die ProfileView-Info's herankommst.

Code:

---

Public Sub getProfileInfo()
  Const AeccProgID As String = "AeccXUILand.AeccApplication.7.0"  'Versionsnummer anpassen!
  Dim tAcadApp As AcadApplication
  Dim tAeccApp As AeccApplication
  Dim tAeccDoc As AeccDocument
  Dim tAeccDocDB As AeccDatabase
 
  Set tAcadApp = ThisDrawing.Application
  Set tAeccApp = tAcadApp.GetInterfaceObject(AeccProgID)
  Set tAeccDoc = tAeccApp.ActiveDocument
  Set tAeccDocDB = tAeccDoc.Database
 
  Dim tSite As AeccSite
  Dim tAlignment As AeccAlignment
  Dim tProfileView As AeccProfileView
  For Each tSite In tAeccDocDB.Sites
      For Each tAlignment In tSite.Alignments
        Call ThisDrawing.Utility.Prompt(vbCrLf & "Achse: " & tAlignment.Name & vbCrLf)
        For Each tProfileView In tAlignment.ProfileViews
            Call ThisDrawing.Utility.Prompt("  Profilname: " & tProfileView.DisplayName & vbCrLf)
            Call ThisDrawing.Utility.Prompt("      Basishöhe: " & tProfileView.ElevationMin & vbCrLf)
            Dim tExtMin As Variant
            Dim tExtMax As Variant
            Call tProfileView.GetBoundingBox(tExtMin, tExtMax)
            Call ThisDrawing.Utility.Prompt("      Einfügepunkt: " & CStr(tExtMin(0)) & "," & CStr(tExtMin(1)) & vbCrLf)
        Next
      Next
  Next
End Sub

---

Nicht vergessen:
- die Verweise in Deinem VBA-Projekt zu setzen
- die Versionsnummer von AeccApp (bei GetInterfaceObject) auf Deine Version anzupassen.

HTH, - alfred -

------------------
www.hollaus.at

---

vielen Dank! probier' ich demnächst gleich mal aus.

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

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

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

---

vielen Dank nochmal für die Antwort, war zwar nicht exakt das, was ich gebraucht hätte, war aber dann doch so gut, dass ich mir das selber erschliessen konnte.
Einmal auf den Geschmack gekommen, kann ich's nicht lassen, gleich was anderes programmieren zu wollen, aber leider sind da mal wieder meine Kenntnisse zu gering, vllt. kann mir ja wieder jemand helfen.

Ich möchte nun also eine AutoCAD-linie auswählen und diese in eine Achse umwandeln und zeichnen lassen, das möchte ich mit folgendem Code machen:
----------------------------------------------------------------------------------------------------
    Dim oAlignmentStyle As AeccAlignmentStyle
    Dim oAlignmentLabelStyleSet As AeccAlignmentLabelStyleSet
    Dim oAlignment As AeccAlignment
    Dim strReihenname As String
    Dim oAlignments As AeccAlignments
    Dim oPoly As AcadLWPolyline
    Dim dblPoints(0 To 3) As Double
    Dim Anz As Double

    'Anfangs- und Endpunkt der ausgewählten Linie
    dblPoints(0) = dblLStartPkt(0): dblPoints(1) = dblLStartPkt(1)
    dblPoints(2) = dblLEndPkt(0): dblPoints(3) = dblLEndPkt(1)
    Set oAlignments = tAeccDoc.AlignmentsSiteless
   
    i = 0: j = 0
    ' Ermittlung der Position des LabelStyleSets innerhalb tAeccDoc um die gewünschte Darstellung zu ermöglichen
    Do Until tAeccDoc.AlignmentLabelStyleSets.Item(i).Name = "Profilschnitt"
        i = i + 1
    Loop
    ' Ermittlung der Position des AlignmentStyles innerhalb tAeccDoc um die gewünschte Darstellung zu ermöglichen
    Do Until tAeccDoc.AlignmentStyles.Item(j).Name = "Standard"
        j = j + 1
    Loop

    'Zuweisung der xy-Werte an LWPolyline
    Set oPoly = tAeccDoc.ModelSpace.AddLightWeightPolyline(dblPoints)

    ' Create an alignment from the polyline object. Draw to
    ' layer 0, erase the polyline when we are done, and
    ' insert curves between line segments.
    Set oAlignment = oAlignments.AddFromPolyline( _
    "Sample Alignment from Polyline", _
    "0", _
    oPoly.ObjectID, _
    tAeccDoc.AlignmentStyles.Item(j).Name, _
    tAeccDoc.AlignmentLabelStyleSets.Item(i).Name, _
    True, _
    True)
--------------------------------------------------------------------------------------------

bis zum letzten Abschnitt ('Create an alignment from...) tritt kein Fehler auf, auch den letzten Abschnitt durchläuft man ohne Fehlermeldung.
Nur: es passiert nichts.
Das "oAlignment" hat nach dem Durchlaufen des Codes den Wert "Nothing". Am Namen des Alignments und dem Layer kann's ja auch nicht liegen.
tAeccDoc.AlignmentStyles.Item(j).Name gibt es und tAeccDoc.AlignmentLabelStyleSets.Item(i).Name ebenso, beide Variablen haben auch den gewünschten Wert.

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

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

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