---

kann ich eine LISP erstellen, wo ich in der Zeichnung auf eine Zahl klicke und autocad zeichnet mir eine Linie mit der Länge des angeklickten Wertes?
Ich habe eine 2D Punktwolke (Punkt ,Code und Höhenangabe) in der Draufsicht. Jetzt möchte ich diese in eine Ansicht Projektieren, Habe mir hierfür eine Linie (Meine HöHE NN) erstellt. Jetzt wähle ich einen Punkt, mit einer Funktion zieht autocad mir eine linie bis zu meiner Nullinie, - (ab hier weiss ich nicht mehr weiter) , Jetzt möchte ich die Höhenangabe klicken und autocad soll meine Linie von NN um die Höhenangabe verlängern.

Würde mich sehr darüber freuen , wenn mir da jemand einen Tipp geben könnte, oder eventuell einen besseren Vorschlag für mich hätte, mal sehen.

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

---

Hallo MOE II, willkommen im Forum

Unter VBA wäre es kein Problem, aber wenn Du eine Lisp-Antwort im VBA-Forum möchtest wird es für mich schwierig.
Kann Lisp zwar einigermaßen lesen aber selber programmieren ... 

Magst mal Deine System-Info ausfüllen (unter dem Editierfenster und im Profil-Profil bearbeiten)

Grüße
Klaus 

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

---

Hallo Klaus
Erstmals danke für deine prompte Reaktion.
Wir arbeiten mit autocad 11 12 13 und Autocad Civil 2010.
Eigentlich wäre es mir egal ob VBA oder Lisp. 

Bis Dahin

Grüsse Armand

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

---

Kannst Du mal eine Beispielzeichnung mit einigen Punkten und der Linie hochladen?
Und vielleicht auch einen Teil der Punktwolke, vielleicht kannst Du Dir über Civil ja einiges an "Handarbeit" ersparen.

Wenn ich es recht verstehe möchtest Du eine Art Balkendiagramm ausgehend von einer bestimmten Höhe bis zu der Höhe des Punktes.

Grüße
Klaus  

[Diese Nachricht wurde von KlaK am 25. Mrz. 2013 editiert.]

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

---

DACH.dwg

Hallo Klaus,

Genau, ich möchte ein Balkendiagramm erstellen, jeoch die Balken interssieren mich nicht,die werden am Ende gelöscht (hier eine beispielzeichnung,) Mit dem Civil binich nicht So Fit, habe schon einiges probiert , aber das wurde mir zu ungenau.

Beste Grüsse Armand

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

---

Hallo

hat ein wenig länger gedauert, kam im Büro nicht dazu ..

Den untenstehenden Code müßtest Du in Deine VBA Umgebung kopieren (VBAIDE)
dann kannst Du die Projektion starten.

Drehungen oder sonstige Hilfslinien sind nicht nötig, kannst direkt in der Originalzeichnung arbeiten.

Code:

---

Sub Projektion()

    Dim tAchse As AcadLine  'Achse im Objekt
    Dim tStart(0 To 2) As Double
    Dim tEnde(0 To 2) As Double
    Dim basePnt As Variant
    Dim baseEnd(0 To 2) As Double
    Dim tLot As Double
    Dim tAbstand As Double
    Dim dZ As Double
    Dim pLine As AcadLine
    Dim tPnt As Variant
    Dim refPnt(0 To 2) As Double
    Dim PLineObj As AcadLine
    Dim PlStart(0 To 2) As Double
    Dim PlEnd(0 To 2) As Double
    Dim returnObj As AcadObject
    Dim returnReal As Double
 
ACHSE:
    ' Achse holen
    ThisDrawing.Utility.GetEntity returnObj, pPoint, "Bitte Achse tippen ..."
    If Err <> 0 Then
        Err.Clear
        result = MsgBox("Wirklich beenden ?", vbOKCancel, "Achse tippen")
        If result = vbOK Then Exit Sub
    Else
        If returnObj.ObjectName = "AcDbLine" Then
          Set tAchse = returnObj
          ' Anfang und Ende der Line zwischenspeichern
          tStart(0) = tAchse.startPoint(0)
          tStart(1) = tAchse.startPoint(1)
          tStart(2) = tAchse.startPoint(2)
          tEnde(0) = tAchse.endPoint(0)
          tEnde(1) = tAchse.endPoint(1)
          tEnde(2) = tAchse.endPoint(2)
          ' Ausgangspunkt für Projektion holen
          basePnt = ThisDrawing.Utility.GetPoint(, "Bezugspunkt der Projektionslinie: ")
          ' Basislinie zeichen
          PlStart(0) = basePnt(0)
          PlStart(1) = basePnt(1)
          PlStart(2) = 0#
          PlEnd(0) = PlStart(0) + tAchse.Length
          PlEnd(1) = PlStart(1)
          PlEnd(2) = 0#
          Set PLineObj = ThisDrawing.ModelSpace.AddLine(PlStart, PlEnd)
          PLineObj.Update
          'Bezugshöhe abfragen
          returnReal = ThisDrawing.Utility.GetReal("Bezugshöhe: ")
          'Ab hier alle Punkte durchtippen
          On Error Resume Next
REFPUNKT:
          tPnt = ThisDrawing.Utility.GetPoint(, "Höhenpunkte tippen ... ")
          If Err <> 0 Then
            Err.Clear
            result = MsgBox("Projektion beenden?", vbOKCancel)
            If result = vbOK Then GoTo ACHSE Else GoTo REFPUNKT
          Else
            'Abstand berechnen
            refPnt(0) = tPnt(0)
            refPnt(1) = tPnt(1)
            refPnt(2) = tPnt(2)
            Call Lot(tStart, tEnde, refPnt, tLot, tAbstand)
            ' Hilfslinie zeichnen
            PlStart(0) = basePnt(0) + tLot
            PlStart(1) = basePnt(1)
            PlStart(2) = 0#
            PlEnd(0) = PlStart(0)
            PlEnd(1) = PlStart(1) + refPnt(2) - returnReal
            PlEnd(2) = 0#
            Set PLineObj = ThisDrawing.ModelSpace.AddLine(PlStart, PlEnd)
            PLineObj.Update
          End If
          'nächsten Punkt holen
          GoTo REFPUNKT
        Else
          MsgBox "Bisher nur Linien tippen ! "
        End If
    End If
    GoTo ACHSE
End Sub

Sub Lot(StartPnt() As Double, Endpnt() As Double, RefPoint() As Double, Station As Double, Abstand As Double)

  ' Berechnet Station und Abstand des Lotes eines RefPunktes auf eine Linie
  ' und gibt diese zurück

    Dim returnObj As AcadObject
    Dim basePnt As Variant
    Dim lineObj As AcadLine
    Dim returnPnt As Variant
    Dim neuPnt(0 To 2) As Double 'Übernimmt Lotpunkt des Vergleich Abschnittes
    Dim dx As Double, dy As Double, dZ As Double 'für Berechnung Strecken
    Dim sa As Double, sb As Double, sc As Double 'Streckenlängen im Dreieck
    Dim sh As Double  'Höhe im Dreieck
    Dim sp As Double  'Fußpunkt im Dreieck
   
    dx = Endpnt(0) - RefPoint(0)
    dy = Endpnt(1) - RefPoint(1)
    'dz = endPnt(2) - RefPoint(2)
    sb = (dx * dx) + (dy * dy) ' + (dz * dz) '=b*b
    dx = RefPoint(0) - StartPnt(0)
    dy = RefPoint(1) - StartPnt(1)
    'dz = RefPoint(2) - startPnt(2)
    sa = (dx * dx) + (dy * dy) '+ (dz * dz) '=a*a
    dx = Endpnt(0) - StartPnt(0)
    dy = Endpnt(1) - StartPnt(1)
    'dz = endPnt(2) - startPnt(2)
    sc = Sqr((dx * dx) + (dy * dy)) '+ (dz * dz) '=c
    sp = (sa - sb + sc * sc) / (2 * sc) ' = Abstand von Startpunkt bis Lot
    sh = (sa - sp * sp) '=Lotlänge
    If sh < 0 Then sh = 0# Else sh = Sqr(sh)
    Station = sp
    Abstand = sh
End Sub

---

Unter Civil ginge es zwar auch, ist aber zugegebenermaßen etwas komplizierter:

Du brauchst zu Beginn ein DGM, entweder aus den Bodenpunkten oder über mind. drei Punkte auf einer Bezugsebene.
Dann erzeugst Du einen Längenschnitt mit Deinen gewünschten Punkten als Stützpunkte (keine Ausrundungen) und daraus einen Höhenplan
Ein weiterer Längenschnitt wird über die gewünschte Achse erzeugt und in dessen Höhenplan der erste Höhenplan als überlagerter (projizierter) Längenschnitt hinzugefügt.
Klappt prima, aber man muß sich einarbeiten ..

Viel Spaß beim testen,
Klaus 

PS.: Nur mal als Anregung: Wäre es nicht sinnvoller anstelle getrennter Punkte und Texte Blöcke mit Attributen zu verwenden? Eure Kunden/AG werden es Euch danken.

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

---

Hallo Klaus,

Das ging aber Flott finde ich trotzdem,
Danke für deine Hilfe, ich bin noch am rum testen, aber ich gehe davon aus , dass das so klappt, man stösst ja immer wieder auf unerwartete Ausnahmen.
Ich würde auch am liebsten mit Blöcken und Attributen arbeiten, aber diese Entscheidung darf ich nicht nehmen, (hatte den Vorschlag schon gemacht)
Wünsche dir ein Frohes Osterwochenende und werde mich auf jedenfall bei dir rückmelden, wenn du damit einverstanden bist.

Bis dahin
Grüsse Armand

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

---

Hallo Klaus,

Sorry, dass ich mich jetzt erst melde.

Recht herzlichen Dank für Deine Hilfe. Das Programm entspricht meinen Vorstellungen.

Grüsse Armand

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

---

Schön, dann kannst Du ja selber weitermachen 
Die verbindende Polylinie gleich mit zu erzeugen wäre auch ein einfaches ...
ebenso Texte (Höhen) dazuschreiben, alles was das Leben einfacher macht.

Grüße,
Klaus   

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

---

ALso, ich muss zugeben, ich hätte das nicht hingekriegt.

Dein Vorschlag gefällt mir aber ich muss mich in VBA neu einarbeiten,
liegt doch etwas weiter zurück bei mir.

nochmals vielen Dank

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