Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  Lisp
  HB.lsp Interpolieren

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
  
Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte
Autor Thema:  HB.lsp Interpolieren (1430 mal gelesen)
-sauer
Mitglied
Zeichner


Sehen Sie sich das Profil von -sauer an!   Senden Sie eine Private Message an -sauer  Schreiben Sie einen Gästebucheintrag für -sauer

Beiträge: 314
Registriert: 01.03.2007

ACAD2012, MEP2012

erstellt am: 01. Apr. 2014 11:00    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Leute,
wir benutzen schon seit längerem das HB.lsp die Funktion HBHoeheSimple um Punkte zu interpolieren... aber seit wir 2014 auf den Rechnern drauf haben... kommt da die Meldung

HBHoeheSimple *Abbruch*
Fehler bei ARXLOAD

hat wohl was mit der geomcal.arx zu tun ... hab woanders gelesen das es wohl in ACAD2014 integriert wurde.. aber was man jetzt bei der Lisp ändern muß weis ich nicht...

bei 2012 geht es ohne Probleme...

Weis jemand Rat? Oder hat eventuell schon die Lösung...?

Hier mal das was ich gefunden habe:

(defun HB_F_Init (/ tmp)
;Initialisieren der globalen Variablen, VL-Erweiterung und des Textstils
    (if (not hb_init)
  (progn ;ARX für Kalkulationsunterstützung laden
      (arxload "geomcal.arx")
      (setq tmp (getvar "TEXTSTYLE"))
      (setq hb_schwellwert 0.00
    hb_zwert    0.00
    hb_genau    3
    hb_init    T
    hb_line    "\n-------------------------------"
    hb_textstyle  "Höhenberechnung-GEF"
    hb_textsize    0.625
    HB_fuzzy    0.01
      ) ;_ Ende von setq
      (vl-load-com)
      (if (not (tblsearch "STYLE" hb_textstyle))
    (command "_-style"
    hb_textstyle
    "isocp2.shx"
    hb_textsize
    0.8
    0.0
    "_n"
    "_n"
    "_n"
    ) ;_ Ende von command
      ) ;_ Ende von if
      (setvar "TEXTSTYLE" tmp)
  ) ;_ Ende von progn
    ) ;In jedem Fall zu initialisierende Variable
    (setq HB_Container nil
  HB_Elements nil
  HB_error *error*
  *error* *HBErrorhandle*
  ;*error* nil
    ) ;UNDO starten
(HB_F_UCS)
    (command "_.UNDO" "_Begin")
) ;defun HB_F_Init()

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
; Routineeigene Fehlerbehandlung
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun *HBErrorhandle* (errmsg)
    (if (or (= errmsg "Beenden/Verlassen abbrechen")
    (= errmsg "Funktion abgebrochen")
    (= errmsg "Function cancelled")
    (= errmsg "quit / exit abort")
) ;_ Ende von or
  (progn
;Objekte, die derzeit hervorgehoben sind, nochmals normal zeichnen
      (if (> (length HB_Container) 0)
    (mapcar '(lambda (en_tmp) (redraw en_tmp 4))
    HB_Container
    ) ;_ Ende von mapcar
      ) ;_ Ende von if
      (if (> (length HB_Elements) 0)
    (mapcar '(lambda (en_tmp) (entdel en_tmp))
    HB_Elements
    ) ;_ Ende von mapcar
      ) ;Undo-Ereignis beenden
(command "_ucs" "_r" "HB_tmp")
      (command "_.UNDO" "_End")

  ) ;_ Ende von progn
  (progn (princ) (princ (strcat "\nError: " msg)))
    ) ;Systemvariablen wiederherstellen
    (HB_F_sysvar hb_sys) ;Alten Errorhandler wiederherstellen
    (setq *error* HB_error) ;Ende
    (print)
) ;_ Ende von defun

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
; Funktion Speichert das aktuelle UCS und stellt WELT-Koordinatensystem her
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun HB_F_UCS ( / dump)

(setq dump (tblsearch "ucs" "HB_tmp" T))
(if dump (command "_ucs" "_D" "HB_tmp"))
(command "_ucs" "_s" "HB_tmp")
(command "_ucs" "_w")
)

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
; Funktion fragt vom Benutzer Punkt und Höhe einer Koordinate.
; Bei Abbruch durch den Benutzer brincht die Funktion über HB_Abort die Bearbeitung ab
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun HB_F_GetpointSimple (msg / p_tmp z_tmp)
    (if (not (setq p_tmp (getpoint msg)))
  (HB_F_Abort "\nAbbruch durch Benutzer")
  (progn (if (not (setq z_tmp
    (getreal "\nHöhe der Koordinate: ")
  ) ;_ Ende von setq
    ) ;_ Ende von not
      (HB_F_Abort "\nAbbruch durch den Benutzer")
) ;_ Ende von if
  ) ;_ Ende von progn
    ) ;_ Ende von if
    (HB_F_TEXT (rtos z_tmp 2 hb_genau) (HB_F_Koord0 p_tmp) T)
    (HB_F_Koord (trans p_tmp 1 0) z_tmp)
) ;defun HB_F_GetpointSimple

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
; Funktion fragt vom Benutzer ein Textelement als Representant für eine
; Koordinate und Höhe ab. Bei Abbruch durch den Benutzer brincht die
; Funktion über HB_Abort die Bearbeitung ab
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun HB_F_Getpoint (msg / p_tmp z_tmp enx_tmp ent_tmp)
    (if (not (setq enx_tmp (nentsel msg)))
  (HB_F_Abort "\nNichts ausgewählt")
  (progn (setq ent_tmp (entget (car enx_tmp)))
(if (member (cdr (assoc 0 ent_tmp))
    '("TEXT" "ATTRIB" "MTEXT" "DTEXT" "RTEXT")
    ) ;_ Ende von member
      (setq p_tmp (cdr (assoc 10 ent_tmp))
    z_tmp (distof (cdr (assoc 1 ent_tmp)) 2)
      ) ;_ Ende von setq
      (HB_F_Abort
  "\nGewähltes Element enthält keinen Text"
      ) ;_ Ende von HB_F_Abort
) ;_ Ende von if
  ) ;_ Ende von progn
    ) ;_ Ende von if
   
    (setq HB_Container (append HB_Container (list (car enx_tmp))))
    (redraw (car enx_tmp) 3)
    (princ (rtos z_tmp 2 hb_genau))
   
    (HB_F_Koord p_tmp z_tmp)
) ;defun HB_F_Getpoint

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
; Funktion liefert eine 3D-Koordinate mit den X/Y-Werten aus P und dem
; Z-Wert aus Z zurück. Der Z-Wert wird entsprechend den Einstellungen von
; HB_Schwellwert/HB_ZWert geprüft und ggf. verändert
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun HB_F_Koord (p z / tmp)
    (append (reverse (cdr (reverse p)))
    (if (>= z HB_Schwellwert)
  (list (+ z hb_zwert))
  (list z)
    ) ;_ Ende von if
    ) ;_ Ende von append
) ;defun HB_F_Koord

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
; Funktion liefert aus einer 3D-Koordinate eine 3D-Koordinate mit Z=0.00
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(defun HB_F_Koord0 (p)
    (append (reverse (cdr (reverse p))) '(0.0))
) ;defun HB_F_Koord0

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
; Funktion liefert ein Element zurück, das für den Befehl HBMessen und
; HBTeilen verwendet werden kann. Bei einer ungültigen Auswahl bricht die
; Funktion selbständig ab
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun HB_F_GetElement (/ hb_enx ent_tmp)
    (if (not (setq tmp_enx (nentsel "\nLinie, Polylinie, Kreis, Bogen oder Spline wählen")))
  (HB_F_Abort "\nNichts ausgewählt")
  (progn
      (setq ent_tmp (cdr (assoc 0 (entget (car tmp_enx)))))
      (if (not (member ent_tmp
'("LINE"
  "LWPOLYLINE"
  "ARC"
  "ELLIPSE"
  "SPLINE"
  "CIRCLE"
)
) ;_ Ende von member
  ) ;_ Ende von not
    (HB_F_Abort
"\nDas gewählte Element ist keines der folgenden Elemente: Linie, Polylinie, Bogen, Spline, Ellipse, Kreis"
    ) ;_ Ende von HB_F_Abort
      ) ;_ Ende von if
  ) ;_ Ende von progn
    ) ;_ Ende von if
    (redraw (car tmp_enx) 3)
    (setq HB_Container (append HB_Container (list (car tmp_enx))))
    tmp_enx
) ;_ Ende von defun

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
; Abbruchfunktion für ein geordnetes Beenden des Programmes. Über A_MSG
; kann durch die Routine, aus der der Abbruch veranlaßt wird, eine Text-
; meldung übergeben werden
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun HB_F_Abort (a_msg)
    (if a_msg
  (princ a_msg)
    ) ;_ Ende von if
    (print)
    (quit)
) ;_ Ende von defun

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
; Funktion zum Rückstellen des Ursprungszustand von AutoCad. Routine wird
; von allen PUBLIC Funktionen am Ende aufgerufen
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun HB_F_End (tmp_sysvar)
;Objekte, die derzeit hervorgehoben sind, nochmals normal zeichnen
    (if (> (length HB_Container) 0)
  (mapcar '(lambda (en_tmp) (redraw en_tmp 4)) HB_Container)
    ) ;Während der Laufzeit erstellte Objekte löschen
    (if (> (length HB_Elements) 0)
  (mapcar '(lambda (en_tmp) (entdel en_tmp)) HB_Elements)
    ) ;Undo-Ereignis beenden
(command "_ucs" "_r" "HB_tmp")
    (command "_.UNDO" "_End") ;Systemvariablen wiederherstellen
    (HB_F_sysvar tmp_sysvar) ;Standardausgabe
    (print)
) ;_ Ende von defun

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
; Ändert bzw. stellt Systemvariablen wieder her, die als Liste 'L'
; übergeben werden
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun HB_F_sysvar (l)
    (mapcar '(lambda (x / var val vlist)
  (setq var  (if (listp x)
    (car x)
    x
      ) ;_ Ende von if
val  (if (listp x)
    (eval (cadr x))
    nil
      ) ;_ Ende von if
vlist (list var (getvar var))
  ) ;_ Ende von setq
  (if val
(setvar var val)
  ) ;_ Ende von if
  vlist
      ) ;_ Ende von lambda
    l
    ) ;_ Ende von mapcar
) ;_ Ende von defun

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
; Routine gibt an Koordinate P den Text MSG aus. Ist FLAG nicht nil,
; wird das erzeugte Element in HB_ELEMENT abgelegt und durch die Routine
; HB_F_END bzw. *HBErrorHandle* am Ende wieder gelöscht
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun HB_F_TEXT (msg p flag / tmpent)
    (setq tmpent (list '(0 . "TEXT")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 p)
(cons 8 (getvar "CLAYER"))
(cons 7 hb_textstyle)
(cons 40 hb_textsize)
(cons 1 msg)
  ) ;_ Ende von list
    ) ;_ Ende von setq
    (entmake tmpent)
    (if flag
  (setq HB_Elements (append HB_Elements (list (entlast))))
    ) ;_ Ende von if
) ;_ Ende von defun


;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
; Ermittelt die Gesamtlänge des Elements 'en'
; Von Tom Fredke / Forum unter www.industrie24.com
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun HB_F_Laenge (en / tmpL1 tmpL2)
    (command "_area" "_O" en "")
    (setq tmpL1 (vlax-curve-getDistAtParam
      (vlax-ename->vla-object en)
      (vlax-curve-getEndParam
  (vlax-ename->vla-object en)
      ) ;_ Ende von vlax-curve-getEndParam
) ;_ Ende von vlax-curve-getDistAtParam
  tmpL2 (getvar "PERIMETER")
    ) ;_ Ende von vlax-curve-getDistAtParam
    (if (not (equal tmpL1 tmpL2 0.000001))
  (HB_F_Abort
      "\nFehler bei der Längenermittlung mit VLX-Code aufgetreten. Abbruch"
  ) ;_ Ende von HB_F_Abort
    ) ;_ Ende von if
    tmpL1
) ;_ Ende von defun

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
; Ermittelt verschiedene Werte für die Routine HB_F_TeilenSUB und
; HB_F_MessenSUB und gibt diese in der globalen variable HB_STEIGUNG
; zurück
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun HB_F_SteigungsBerechnung
      (p1 p2 tmp_en / l1 l2 z1 z2 steigung p1_curve p2_curve)
;Objekt aus tmp_en ableiten
    (setq enObj (vlax-ename->vla-object tmp_en))
;Durch Benutzer eingegebene Punkte auf Objekt abbilden
    (setq p1_curve (vlax-curve-getclosestpointto
enobj
(trans (HB_F_Koord0 p1) 1 0)
    ) ;_ Ende von vlax-curve-getclosestpointto
  p2_curve (vlax-curve-getclosestpointto
enobj
(trans (HB_F_Koord0 p2) 1 0)
    ) ;_ Ende von vlax-curve-getclosestpointto
    ) ;Genauigkeit der gezeigten zu den ermittelten Punkten bestimmen
    (if (not (equal (trans (HB_F_Koord0 p1) 1 0) p1_curve HB_fuzzy))
  (HB_F_Abort
      "\nDer erste Punkt liegt nicht auf dem gewählten Objekt"
  ) ;_ Ende von HB_F_Abort
    ) ;_ Ende von if
    (if (not (equal (trans (HB_F_Koord0 p2) 1 0) p2_curve HB_fuzzy))
  (HB_F_Abort
      "\nDer zweite Punkt liegt nicht auf dem gewählten Objekt"
  ) ;_ Ende von HB_F_Abort
    ) ;Berechnung
    (setq l1        (vlax-curve-getDistAtPoint enObj p1_curve)
  l2        (vlax-curve-getDistAtPoint enObj p2_curve)
  z1        (caddr p1)
  z2        (caddr p2)
  steigung    (/ (- z1 z2) (- l1 l2))
  HB_Steigung (list steigung l1 l2 z1 z2 tmp_en)
    ) ;_ Ende von setq
) ;_ Ende von defun

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
; Funktion setzt einen Punkt an PT_TMP und nimmt diesen in die Liste von
; HB_ELEMENTS auf
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun HB_F_Point (pt_tmp)
    (command "_point" pt)
    (setq HB_Elements (append HB_Elements (list (entlast))))
) ;_ Ende von defun


;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
; Berechnet die lineare Steigung zwischen zwei Punkten
;
; Manuelle Eingabe der Punkte
;
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun c:HBSteigungSimple (/ p1 p2) ;Init
    (setq hb_sys (HB_F_sysvar '(("DIMZIN" 0) ("CMDECHO" 0))))
    (HB_F_Init) ;Benutzereingabe
    (setq p1 (HB_F_GetpointSimple "\nErsten Punkt zeigen")
  P2 (HB_F_GetpointSimple "\nZweiten Punkt zeigen")
    ) ;_ Ende von setq
;Unterroutine
    (HBSteigungErgebnis p1 p2) ;Ende
    (HB_F_End hb_sys)
) ;defun HBSteigungSimple ()

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
; Berechnet die lineare Steigung zwischen zwei Punkten
; Eingabe der Punkte durch Auswahl von TEXT/DTEXT/ATTRIBUT/MTEXT
; der die Höhe am Einfügepunkt des Textes repräsentiert
;
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun C:HBSteigung (/ p1 p2) ;Init
    (setq hb_sys (HB_F_sysvar '(("DIMZIN" 8) ("CMDECHO" 0))))
    (HB_F_Init) ;Benutzereingabe
    (setq p1 (HB_F_Getpoint "\nErsten Punkt zeigen: ")
  P2 (HB_F_Getpoint "\nZweiten Punkt zeigen: ")
    ) ;_ Ende von setq
;Unterroutine
    (HBSteigungErgebnis p1 p2) ;Ende
    (HB_F_End hb_sys)
) ;defun HBSteigungSimple ()

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
; Weiterverarbeitung der Daten aus den Routinen
; c:HBSteigung und c:HBSteigungSimple
;
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun HBSteigungErgebnis (p1 p2 / result)
    (setq result (/ (* 100 (- (caddr p2) (caddr p1)))
    (distance (HB_F_Koord0 p1) (HB_F_Koord0 p2))
  ) ;_ Ende von /
    ) ;_ Ende von setq
    (princ hb_line)
    (princ
  (strcat "\nRechnung (Delta H/L): "
  (rtos (* 100 (- (caddr p2) (caddr p1))) 2 hb_genau)
  "cm / "
  (rtos (distance (HB_F_Koord0 p1) (HB_F_Koord0 p2))
2
hb_genau
  ) ;_ Ende von rtos
  "m"
  ) ;_ Ende von strcat
    ) ;_ Ende von princ
    (princ (strcat "\nSteigung: " (rtos result 2 hb_genau) " %"))
) ;defun HBSteigungErgebnis ()

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
; Ermittelt die interpolierten Höhen linear zwischen zwei Punkten
; Manuelle Eingabe der Punkte
;
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun c:HBHoeheSimple (/ steigung result)
    (setq hb_sys (HB_F_sysvar '(("DIMZIN" 0) ("CMDECHO" 0))))
    (HB_F_Init)
    (setq p1 (HB_F_GetpointSimple "\nErsten Punkt zeigen")
  P2 (HB_F_GetpointSimple "\nZweiten Punkt zeigen")
    ) ;_ Ende von setq
    (HBHoeheErgebnis p1 p2) ;Ende
    (HB_F_End hb_sys)
) ;_ Ende von defun

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
; Ermittelt die interpolierten Höhen linear zwischen zwei Punkten
; Eingabe der Punkte durch Auswahl von TEXT/DTEXT/ATTRIBUT/MTEXT
; der die Höhe am Einfügepunkt des Textes repräsentiert
;
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun c:HBHoehe (/ p1 p2)
    (setq hb_sys (HB_F_sysvar '(("DIMZIN" 0) ("CMDECHO" 0))))
    (HB_F_Init)
    (setq p1 (HB_F_Getpoint "\nErsten Punkt zeigen: ")
  p2 (HB_F_Getpoint "\nZweiten Punkt zeigen: ")
    ) ;_ Ende von setq
    (HBHoeheErgebnis p1 p2) ;Ende
    (HB_F_End hb_sys)
) ;_ Ende von defun

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
; Weiterverarbeitung der Daten aus den Routinen
; c:HBHoehe und c:HBHoeheSimple
;
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun HBHoeheErgebnis (p1 p2 / ergebis steigung px h1 d1)
;Steigung berechnen
    (setq d1    (distance (HB_F_Koord0 p1) (HB_F_Koord0 p2))
  h1    (- (caddr p2) (caddr p1))
  steigung (/ h1 d1) ;_ Ende von /
    ) ;_ Ende von setq
    (princ hb_line)
    (princ (strcat "\nSteigung: " (rtos (* (abs h1) 100.0) 2 1) " cm / " (rtos (abs d1) 2 hb_genau) " m"))   
    (princ (strcat "\nSteigung: "
    (rtos (* steigung 100.0) 2 hb_genau)
    " %"
    ) ;_ Ende von strcat
    ) ;_ Ende von princ
;;;    (princ (strcat "\nHöhen Z1="
;;;    (rtos (caddr p1) 2 3)
;;;    "m | Z2="
;;;    (rtos (caddr p2) 2 3)
;;;    "m"
;;;    ) ;_ Ende von strcat
;;;    )
;Schleife
    (setq px (getpoint "\nAbfragepunkt ..."))
    (while (> (length px) 0) ;Berechnung
  (setq ergebnis (+ (* steigung
      (distance (HB_F_Koord0 p1)
(HB_F_Koord0 (trans px 1 0))
      ) ;_ Ende von distance
    ) ;_ Ende von *
    (caddr p1)
) ;_ Ende von +
  ) ;Benutzerausgabe
  (HB_F_TEXT (rtos ergebnis 2 hb_genau) (HB_F_Koord0 px) nil)
;Neuer Abfragepunkt
  (setq px (getpoint "\nAbfragepunkt ..."))
    ) ;while
) ;defun HB_HoeheErgebnis


;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
; Ermittelt das resultierende Gefälle aus einer geneigten Fläche definiert
; durch 3 Punkte
;
; Eingabe der Punkte durch Auswahl von TEXT/DTEXT/ATTRIBUT/MTEXT
; der die Höhe am Einfügepunkt des Textes repräsentiert
;
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun c:HBSteigung3P (/ p1 p2 p3)
    (setq hb_sys (HB_F_sysvar '(("DIMZIN" 0) ("CMDECHO" 0))))
    (HB_F_Init)
    (setq p1 (HB_F_Getpoint "\nErsten Punkt zeigen: ")
  P2 (HB_F_Getpoint "\nZweiten Punkt zeigen: ")
  P3 (HB_F_Getpoint "\nDritten Punkt zeigen: ")
    ) ;_ Ende von setq
    (HBSteigung3PErgebnis p1 p2 p3) ;Ende
    (HB_F_End hb_sys)
) ; defun HBHoehe3P

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
; Ermittelt das resultierende Gefälle aus einer geneigten Fläche definiert
; durch 3 Punkte
;
; Manuelle Eingabe der Punkte
;
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun c:HBSteigung3PSimple ()
        (setq hb_sys (HB_F_sysvar '(("DIMZIN" 0) ("CMDECHO" 0))))
    (HB_F_Init)
    (setq p1 (HB_F_GetpointSimple "\nErsten Punkt zeigen")
  P2 (HB_F_GetpointSimple "\nZweiten Punkt zeigen")
  p3 (HB_F_GetpointSimple "\nDritten Punkt zeigen")
    ) ;_ Ende von setq
    (HBSteigung3PErgebnis p1 p2 p3) ;Ende
    (HB_F_End hb_sys)
)

(defun HBSteigung3PErgebnis (p1 p2 p3 / p4 p5 tmp_zlist tmp_z_min_max winkel)
;Variablen für c:kal öffentlich machen
    (setq ofp3 p1
  ofp4 p2
  ofp5 p3
    ) ;niedrigsten/höchsten Z-Wert ermitteln
    (setq tmp_zlist (mapcar 'caddr (list ofp3 ofp4 ofp5))
  tmp_zlist (vl-sort tmp_zlist '< )
  tmp_z_min_max (list (car tmp_zlist) (car (reverse tmp_zlist)))
    ) ;_ Ende von setq
    (princ hb_line)
    (princ (strcat "\nHöhen Z1="
    (rtos (caddr p1) 2 3)
    "m | Z2="
    (rtos (caddr p2) 2 3)
    "m | Z3="
    (rtos (caddr p3) 2 3)
    ) ;_ Ende von strcat
    ) ;_ Ende von princ
    (setq winkel (c:kal "ANG(NOR(ofp3,ofp4,ofp5))")
  p4  (c:kal "(ofp3+ofp4+ofp5)/3")
  p5  (polar p4 (/ (* winkel 3.14159) 180.0) 1.0)
    ) ;_ Ende von setq
    (setq ofp1 (HB_F_Koord (trans p4 1 0) (car tmp_z_min_max)) ;_ Ende von HB_F_Koord
  ofp2 (HB_F_Koord (trans p4 1 0) (cadr tmp_z_min_max)) ;_ Ende von HB_F_Koord
  pn1 (c:kal "ILP(ofp1,ofp2,ofp3,ofp4,ofp5)")
    ) ;_ Ende von setq
    (setq ofp1 (HB_F_Koord (trans p5 1 0) (car tmp_z_min_max)) ;_ Ende von HB_F_Koord
  ofp2 (HB_F_Koord (trans p5 1 0) (cadr tmp_z_min_max)) ;_ Ende von HB_F_Koord
  pn2 (c:kal "ILP(ofp1,ofp2,ofp3,ofp4,ofp5)")
    ) ;_ Ende von setq
    (setq result (/ (* 100 (- (caddr pn2) (caddr pn1)))
    (distance (HB_F_Koord0 pn1) (HB_F_Koord0 pn2))
  ) ;_ Ende von /
    ) ;_ Ende von setq
   
    (princ hb_line)
    (command "_line" (HB_F_koord0 pn1) (HB_F_Koord0 pn2) "")
    (HB_F_TEXT (strcat (rtos result 2 hb_genau) "%") (HB_F_koord0 pn1) nil)
    (princ (strcat "\nSteigung: " (rtos result 2 hb_genau) " %"))
    (princ (strcat "\nWenkel zur Waagrechten: " (rtos winkel 2 hb_genau) "°"))
   
    (setq ofp1 nil
  ofp2 nil
  ofp3 nil
  ofp4 nil
  ofp5 nil
    ) ;_ Ende von setq
) ;_ Ende von defun


;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
; Ermittelt die interpolierten Höhen auf einer geneigten Fläche definiert
; durch 3 Punkte
;
; Manuelle Eingabe der Punkte
;
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(defun c:HBHoehe3PSimple (/ p1 p2 p3)
    (setq hb_sys (HB_F_sysvar '(("DIMZIN" 0) ("CMDECHO" 0))))
    (HB_F_Init)
    (setq p1 (HB_F_GetpointSimple "\nErsten Punkt zeigen")
  P2 (HB_F_GetpointSimple "\nZweiten Punkt zeigen")
  p3 (HB_F_GetpointSimple "\nDritten Punkt zeigen")
    ) ;_ Ende von setq
    (HBHoehe3PErgebnis p1 p2 p3) ;Ende
    (HB_F_End hb_sys)
) ;defun HBHoehe3pSimple()


;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
; Ermittelt die interpolierten Höhen auf einer geneigten Fläche definiert
; durch 3 Punkte
;
; Eingabe der Punkte durch Auswahl von TEXT/DTEXT/ATTRIBUT/MTEXT
; der die Höhe am Einfügepunkt des Textes repräsentiert
;
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun c:HBHoehe3P (/ p1 p2 p3)
    (setq hb_sys (HB_F_sysvar '(("DIMZIN" 0) ("CMDECHO" 0))))
    (HB_F_Init)
    (setq p1 (HB_F_Getpoint "\nErsten Punkt zeigen: ")
  P2 (HB_F_Getpoint "\nZweiten Punkt zeigen: ")
  P3 (HB_F_Getpoint "\nDritten Punkt zeigen: ")
    ) ;_ Ende von setq
    (HBHoehe3PErgebnis p1 p2 p3) ;Ende
    (HB_F_End hb_sys)
) ; defun HBHoehe3P

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
; Weiterverarbeitung der Daten aus den Routinen
; c:HBHoehe3P und c:HBHoehe3PSimple
;
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun HBHoehe3PErgebnis (p1 p2 p3 / tmp_zlist tmp_z_min_max)
;Variablen für c:kal öffentlich machen
    (setq ofp3 p1
  ofp4 p2
  ofp5 p3
    ) ;niedrigsten/höchsten Z-Wert ermitteln
    (setq tmp_zlist (mapcar 'caddr (list ofp3 ofp4 ofp5))
  tmp_zlist (vl-sort tmp_zlist '< )
  tmp_z_min_max (list (car tmp_zlist) (car (reverse tmp_zlist)))
    ) ;_ Ende von setq
    (princ hb_line)
    (princ (strcat "\nHöhen Z1="
    (rtos (caddr p1) 2 3)
    "m | Z2="
    (rtos (caddr p2) 2 3)
    "m | Z3="
    (rtos (caddr p3) 2 3)
    ) ;_ Ende von strcat
    ) ;Schleife
    (print (c:kal "ANG(NOR(ofp3,ofp4,ofp5))"))
        (print (c:kal "ABS(NOR(ofp3,ofp4,ofp5))"))
    (setq px (getpoint "\nAbfragepunkt ..."))
    (while (> (length px) 0)
;Öffentliche Variablen aus dem Abfragepunkt ableiten
  (setq ofp1 (HB_F_Koord (trans px 1 0) (car tmp_z_min_max))
ofp2 (HB_F_Koord (trans px 1 0) (cadr tmp_z_min_max))
  ) ;Ergebnis mit Hilfe von c:kal berechnen
  (setq ergebnis (c:kal "ILP(ofp1,ofp2,ofp3,ofp4,ofp5)"))
 
;Ergebnisausgabe
  (HB_F_TEXT (rtos (caddr ergebnis) 2 hb_genau)
    (HB_F_Koord0 px)
    nil
  ) ;Neuen Abfragepunkt ermitteln
  (setq px (getpoint "\nAbfragepunkt ..."))
    ) ;while
    (setq ofp1 nil
  ofp2 nil
  ofp3 nil
  ofp4 nil
  ofp5 nil
    ) ;_ Ende von setq
) ;defun HBHoehe3PErgebnis

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
; Ermittelt die interpolierten Höhen entlang eines Objektes durch
; Angaben eines Startpunktes und einer Steigung
; Eingabe der Punkte durch Auswahl von TEXT/DTEXT/ATTRIBUT/MTEXT
; der die Höhe am Einfügepunkt des Textes repräsentiert
;
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun c:HBPunktSteigung (/ p1) ;Init
    (setq hb_sys (HB_F_sysvar '(("DIMZIN" 0) ("CMDECHO" 0))) ;_ Ende von HB_F_sysvar
    ) ;_ Ende von setq
    (HB_F_Init) ;Startpunkt abfragen
    (setq p1 (HB_F_Getpoint "\nStartpunkt wählen: "))
;Unterroutine aufrufen
    (HBPunktSteigungErgebnis p1) ;Ende
    (HB_F_End)
) ;_ Ende von defun


;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
; Ermittelt die interpolierten Höhen entlang eines Objektes durch
; Angaben eines Startpunktes und einer Steigung
; Manuelle Eingabe der Punkte
;
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun c:HBPunktSteigungSimple (/ p1) ;Init
    (setq hb_sys (HB_F_sysvar '(("DIMZIN" 0) ("CMDECHO" 0))) ;_ Ende von HB_F_sysvar
    ) ;_ Ende von setq
    (HB_F_Init) ;Startpunkt abfragen
    (setq p1 (HB_F_GetpointSimple "\nStartpunkt wählen"))
;Unterroutine aufrufen
    (HBPunktSteigungErgebnis p1) ;Ende
    (HB_F_End)
) ;_ Ende von defun

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
; Weiterverarbeitung der Daten aus den Routinen
; c:HBSteigung und c:HBSteigungSimple
;
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun HBPunktSteigungErgebnis
      (p1 / enx en objen px px_curve p1_curve l1 lx ergebnis)
;Benutzereingabe und Berechnungen
    (setq enx    (HB_F_GetElement)
  en    (car enx)
  enObj    (vlax-ename->vla-object en)
  p1_curve (vlax-curve-getclosestpointto
enObj
(trans (HB_F_Koord0 p1) 1 0)
    ) ;_ Ende von vlax-curve-getclosestpointto
  l1    (vlax-curve-getDistAtPoint enObj p1_curve)
    ) ;Genauigkeit der gezeigten zu den ermittelten Punkten bestimmen
    (if (not (equal (trans (HB_F_Koord0 p1) 1 0) p1_curve HB_fuzzy))
  (HB_F_Abort
      "\nDer gezeigte Punkt liegt nicht auf dem gewählten Objekt"
  ) ;_ Ende von HB_F_Abort
    ) ;_ Ende von if
    (if (member (setq steigung (getreal "\nSteigung angeben: "))
'(NIL 0)
) ;_ Ende von member
  (HB_F_Abort "\n")
    ) ;_ Ende von if
;Schleife
    (setq px (getpoint "\nAbfragepunkt ... "))
    (while (> (length px) 0)
  (setq px_curve (vlax-curve-getclosestpointto
      enobj
      (trans (HB_F_Koord0 px) 1 0)
) ;_ Ende von vlax-curve-getclosestpointto
lx (vlax-curve-getDistAtPoint enObj px_curve)
ergebnis (+ (caddr p1)
    (* (abs (- l1 lx)) (/ steigung 100))
) ;_ Ende von +
  ) ;Ergebnisausgabe
  (HB_F_TEXT (rtos ergebnis 2 hb_genau) px_curve nil)
  (princ (strcat "Detla L = "
(rtos (abs (- l1 lx)) 2 hb_genau)
", Delta H = "
(rtos (* (abs (- l1 lx)) (/ steigung 100))
      2
      hb_genau
) ;_ Ende von rtos
) ;_ Ende von strcat
  ) ;_ Ende von princ
  (setq px (getpoint "\nAbfragepunkt ... "))
    ) ;while
) ;_ Ende von defun

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
; Interpoliert die Höhen entlang eines Objektes in einem definierten Abstand
;
; Eingabe der Punkte durch Auswahl von TEXT/DTEXT/ATTRIBUT/MTEXT
; der die Höhe am Einfügepunkt des Textes repräsentiert
;
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun c:HBMessen (/ p1 p2 tmpEnX)
    (setq hb_sys (HB_F_sysvar '(("DIMZIN" 0) ("CMDECHO" 0))) ;_ Ende von HB_F_sysvar
    ) ;_ Ende von setq
    (HB_F_Init)
    (setq tmpEnX (HB_F_GetElement)
  p1  (HB_F_Getpoint "\nErsten Punkt auf dem Objekt zeigen: ")
  p2  (HB_F_Getpoint "\nZweiten Punkt auf dem Objekt zeigen: ")
    ) ;Zwischenroutine aufrufen
    (HBMessenSub p1 p2 tmpEnX) ;Ende
    (HB_F_End hb_sys)
) ;defun HBMessen()

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
; Interpoliert die Höhen entlang eines Objektes in einem definierten Abstand
;
; Eingabe der Punkte durch Auswahl von TEXT/DTEXT/ATTRIBUT/MTEXT
; der die Höhe am Einfügepunkt des Textes repräsentiert
;
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun c:HBMessenSimple (/ p1 p2 tmpEnX)
    (setq hb_sys (HB_F_sysvar '(("DIMZIN" 0) ("CMDECHO" 0))) ;_ Ende von HB_F_sysvar
    ) ;_ Ende von setq
    (HB_F_Init)
    (setq tmpEnX (HB_F_GetElement)
  p1  (HB_F_GetpointSimple
      "\nErsten Punkt auf dem Objekt zeigen"
  ) ;_ Ende von HB_F_GetpointSimple
  p2  (HB_F_GetpointSimple
      "\nZweiten Punkt auf dem Objekt zeigen"
  ) ;_ Ende von HB_F_GetpointSimple
    ) ;Zwischenroutine aufrufen
    (HBMessenSub p1 p2 tmpEnX) ;Ende
    (HB_F_End hb_sys)
) ;defun HBMessenSimple()

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
; Interpoliert die Höhen entlang eines Objektes in einer definierten Anzahl
;
; Eingabe der Punkte durch Auswahl von TEXT/DTEXT/ATTRIBUT/MTEXT
; der die Höhe am Einfügepunkt des Textes repräsentiert
;
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun c:HBTeilen (/ p1 p2 tmpEnX)
    (setq hb_sys (HB_F_sysvar '(("DIMZIN" 0) ("CMDECHO" 0))) ;_ Ende von HB_F_sysvar
    ) ;_ Ende von setq
    (HB_F_Init)
    (setq tmpEnX (HB_F_GetElement)
  p1  (HB_F_Getpoint "\nErsten Punkt auf dem Objekt zeigen: ")
  p2  (HB_F_Getpoint "\nZweiten Punkt auf dem Objekt zeigen: ")
    ) ;Zwischenroutine aufrufen
    (HBTeilenSub p1 p2 tmpEnX) ;Ende
    (HB_F_End hb_sys)
) ;defun HBTeilen()

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
; Interpoliert die Höhen entlang eines Objektes in einer definierten Anzahl
;
; Manuelle Eingabe der Punkte
;
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun c:HBTeilenSimple (/ p1 p2 tmpEnX)
    (setq hb_sys (HB_F_sysvar '(("DIMZIN" 0) ("CMDECHO" 0))) ;_ Ende von HB_F_sysvar
    ) ;_ Ende von setq
    (HB_F_Init)
    (setq tmpEnX (HB_F_GetElement)
  p1  (HB_F_GetpointSimple
      "\nErsten Punkt auf dem Objekt zeigen"
  ) ;_ Ende von HB_F_GetpointSimple
  p2  (HB_F_GetpointSimple
      "\nZweiten Punkt auf dem Objekt zeigen"
  ) ;_ Ende von HB_F_GetpointSimple
    ) ;Zwischenroutine aufrufen
    (HBTeilenSub p1 p2 tmpEnX) ;Ende
    (HB_F_End hb_sys)
) ;defun HBTeilenSimple()

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
; Funktion fragt ab, in wieviele Teile das Objekt in EnX geteilt werden
; soll und teilt dieses anhand des Befehlts "_MEASURE"
;
; Eingabe: p1 - Erste Punktkoordinate mit Höhenangabe
;          p2 - zweite Punktkoordinate mit Höhenangabe
;          EnX - Objekt entlang dessen die Steigung konstant folgt
;
; Aufruf durch: c:HBMessen und c:HBMessenSimple
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(defun HBMessenSub (p1 p2 EnX / teil) ;Steigungsberechnung durchführen
    (HB_F_SteigungsBerechnung p1 p2 (car tmpEnX)) ;Informationsausgabe
    (princ (strcat "\nGesamtlänge des Elements: "
    (rtos (HB_F_Laenge (car TmpEnX)) 2 hb_genau)
    ) ;_ Ende von strcat
    ) ;_ Ende von princ
    (princ (strcat "\nSteigung des Elements: "
    (rtos (* (nth 0 HB_Steigung) 100) 2 hb_genau)
    "%"
    ) ;_ Ende von strcat
    ) ;Benutzereingabe
    (if (member (setq teil (getreal "\nSegmentlänge angeben: "))
'(nil)
) ;_ Ende von member
  (HB_F_Abort "\n")
    ) ;Element teilen
    (command "_MEASURE" enx teil)
    (if (not (ssget "_P"))
  (HB_F_Abort "\nDie Segmentlänge übersteigt die Objektlänge")
    ) ;Höhenberechnung durchführen
    (HBTeilenMessenErgebnis p1 p2)
) ;_ Ende von defun

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
; Funktion fragt ab, in wieviele Teile das Objekt in EnX geteilt werden
; soll und teilt dieses anhand des Befehlts "_DIVIDE"
;
; Eingabe: p1 - Erste Punktkoordinate mit Höhenangabe
;          p2 - zweite Punktkoordinate mit Höhenangabe
;          EnX - Objekt entlang dessen die Steigung konstant folgt
;
; Aufruf durch: c:HBTeilen und c:HBTeilenSimple
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(defun HBTeilenSub (p1 p2 EnX / teil) ;Steigungsberechnung durchführen
    (HB_F_SteigungsBerechnung p1 p2 (car tmpEnX)) ;Informationsausgabe
    (princ hb_line)
    (princ (strcat "\nGesamtlänge des Elements: "
    (rtos (HB_F_Laenge (car TmpEnX)) 2 hb_genau)
    ) ;_ Ende von strcat
    ) ;_ Ende von princ
    (princ
  (strcat "\nSteigung des Elements: "
  (rtos (* (abs (nth 0 HB_Steigung)) 100) 2 hb_genau)
  "%"
  ) ;_ Ende von strcat
    ) ;Benutzereingabe
    (if  (member (setq teil (getint "\nAnzahl der Segmente eingeben: "))
  '(nil 1)
  ) ;_ Ende von member
      (HB_F_Abort "\nAnzahl der Elemente muß >=2 sein!")
    ) ;Element teilen
    (command "_divide" enx teil) ;Höhenberechnung durchführen
    (HBTeilenMessenErgebnis p1 p2)
) ;_ Ende von defun

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
; Funktion ersetzt die im Auswahlsatz "PREVIOUS" vorhandenen Punkte
; auf dem Element EnX durch die interpolierten Höhen.
;
; Eingabe: p1 - Erste Punktkoordinate mit Höhenangabe
;          p2 - zweite Punktkoordinate mit Höhenangabe
;          EnX - Objekt entlang dessen die Steigung konstant folgt
;
; Aufruf durch: HBTeilenSub und HBMessenSub
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun HBTeilenMessenErgebnis (p1 p2 / l1 lx px z1 ergebnis px_curve)
;Die durch MESSEN/TEILEN neu erstellten Punkte im Auswahlsatz "PREVIOUS" sichern
; Die Anzahl neuer Punkte ernitteln
;sowie die zu EnX übergebenen Eigenschaften speichern
    (setq aw    (ssget "_P")
  anz    (sslength aw)
  steigung (nth 0 HB_Steigung)
  l1    (nth 1 HB_Steigung)
  z1    (nth 3 HB_Steigung)
  en    (nth 5 HB_Steigung)
    )
;Schleife zum Durchlaufen der durch TEILEN/MESSEN gesetzten Punkte
    (while (> anz 0)
  (setq en2    (ssname aw (1- anz))
px    (cdr (assoc 10 (entget en2)))
HB_sys_tmp (HB_F_sysvar '(("SNAPMODE" 0)))
px_curve  (vlax-curve-getclosestpointto
(vlax-ename->vla-object en)
px
  ) ;_ Ende von vlax-curve-getclosestpointto
lx    (vlax-curve-getDistAtPoint
(vlax-ename->vla-object en)
px_curve
  ) ;_ Ende von vlax-curve-getDistAtPoint
ergebnis  (+ z1 (* steigung (- lx l1)))
  ) ;_ Ende von setq
  (HB_F_TEXT (rtos ergebnis 2 hb_genau)
    (trans px_curve 0 1)
    nil
  ) ;_ Ende von HB_F_TEXT
  (HB_F_sysvar HB_sys_tmp)
  (entdel en2)
  (setq anz (1- anz))
    ) ;_ Ende von while
) ;_ Ende von defun

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
; Ermittelt die Interpolierten Höhen entlang eines Objektes durch Anfangs
; und Endpunkt
;
; Manuelle Eingabe der Punkte
;
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=


(defun c:HBErmittelnSimple (/ p1 p2 tmpEnX)
    (setq hb_sys (HB_F_sysvar '(("DIMZIN" 0) ("CMDECHO" 0))) ;_ Ende von HB_F_sysvar
    ) ;_ Ende von setq
    (HB_F_Init)
    (setq tmpEnX (HB_F_GetElement)
  p1  (HB_F_GetpointSimple
      "\nErsten Punkt auf dem Objekt zeigen"
  ) ;_ Ende von HB_F_GetpointSimple
  p2  (HB_F_GetpointSimple
      "\nZweiten Punkt auf dem Objekt zeigen"
  ) ;_ Ende von HB_F_GetpointSimple
    ) ;_ Ende von setq
    (HBErmittelnErgebnis p1 p2 tmpEnX) ;Ende
    (HB_F_End hb_sys)
) ;_ Ende von defun

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
; Ermittelt die Interpolierten Höhen entlang eines Objektes durch Anfangs
; und Endpunkt
;
; Eingabe der Punkte durch Auswahl von TEXT/DTEXT/ATTRIBUT/MTEXT
; der die Höhe am Einfügepunkt des Textes repräsentiert
;
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun c:HBErmitteln (/ p1 p2 tmpEnX)
    (setq hb_sys (HB_F_sysvar '(("DIMZIN" 0) ("CMDECHO" 0))) ;_ Ende von HB_F_sysvar
    ) ;_ Ende von setq
    (HB_F_Init)
    (setq tmpEnX (HB_F_GetElement)
  p1  (HB_F_Getpoint "\nErsten Punkt auf dem Objekt zeigen: ")
  p2  (HB_F_Getpoint "\nZweiten Punkt auf dem Objekt zeigen: ")
    ) ;_ Ende von setq
    (HBErmittelnErgebnis p1 p2 tmpEnX) ;Ende
    (HB_F_End hb_sys)
) ;_ Ende von defun

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
; Weiterverarbeitung der Daten aus den Routinen
; c:HBErmitteln und c:HBErmittelnSimple
;
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun HBErmittelnErgebnis (p1
    p2
    EnX
    /
    p1_curve
    p2_curve
    px_curve
    l1
    l2
    lx
    z1
    z2
    px
    ergebnis
    steigung
    HB_sys_tmp
    en
    ent
  ) ;Steigunsberechnung durchführen
    (HB_F_SteigungsBerechnung p1 p2 (car enX))
;Werte aus Steigungsberechnung zwischenspeichern
    (setq steigung (nth 0 HB_Steigung)
  l1    (nth 1 HB_Steigung)
  l2 (nth 2 HB_Steigung)
  z1    (nth 3 HB_Steigung)
  z2 (nth 4 HB_Steigung)
  en    (nth 5 HB_Steigung)
    ) ;_ Ende von setq
    (princ hb_line)
    (princ (strcat "\nSteigung: " (rtos (* (abs (- z1 z2)) 100.0) 2 1) " cm / " (rtos (abs (- l1 l2)) 2 hb_genau) " m"))
    (princ
  (strcat "\nSteigung: " (rtos (* steigung 100.0) 2 hb_genau) "%")
    ) ;Benutzereingabe
    (setq px (getpoint "\nAbfragepunkt ... ")) ;Schleife
    (while (> (length px) 0)
  (setq px    (HB_F_Koord0 (trans px 1 0))
HB_sys_tmp (HB_F_sysvar '(("SNAPMODE" 0)))
px_curve  (vlax-curve-getclosestpointto
(vlax-ename->vla-object en)
px
  ) ;_ Ende von vlax-curve-getclosestpointto
lx    (vlax-curve-getDistAtPoint
(vlax-ename->vla-object en)
px_curve
  ) ;_ Ende von vlax-curve-getDistAtPoint
ergebnis  (+ z1 (* steigung (- lx l1)))
  ) ;_ Ende von setq
  (princ (strcat (rtos ergebnis 2 hb_genau) "m"))
  (HB_F_TEXT (rtos ergebnis 2 hb_genau)
    (trans px_curve 0 1)
    nil
  ) ;_ Ende von HB_F_TEXT
  (HB_F_sysvar HB_sys_tmp)
  (setq px (getpoint "\nAbfragepunkt ... "))
    ) ;while
) ;defun HB_ErmittelnErgebnis()

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
; Die Funktion schreibt einen Benutzerdefinierten Text an eine
; benutzerdefinierte Koordinate
;
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun c:HBText (/ txt) ;Init
    (setq hb_sys (HB_F_sysvar '(("DIMZIN" 0) ("CMDECHO" 0))) ;_ Ende von HB_F_sysvar
    ) ;_ Ende von setq
    (HB_F_Init) ;Benutzereingabe
    (setq p (getpoint "\nStartpunkt des Textes angeben: ")) ;Schleife
    (while (> (length p) 0)
  (if (not (setq txt (getstring "\nText eingeben: ")))
      (HB_F_Abort "\nKeinen Text eingegeben")
  ) ;_ Ende von if
  (HB_F_TEXT txt p nil)
  (setq p (getpoint "\nStartpunkt des Textes angeben: "))
    ) ;While
;Ende
    (HB_F_End hb_sys)
) ; c:HBText

;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;
; Die Funktion kopiert einen beliebigen Text
; (auch aus Blöchen und Attributen)
;
;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(defun c:HBCopy (/ txt) ;Init
    (setq enX (nentsel "\nQuelltext wählen (auch in Blöcken oder Attributen) "))
    (setq en (car enx))
    (setq ent (entget en))
    (setq txt (cdr (assoc 1 ent)))
    (setq p (getpoint "\nEinfügepunkt des Textes angeben:  "))
    (HB_F_Init)
    (HB_F_TEXT txt p nil)
) ; c:HBText

(princ "\nRoutine zum Berechnen von Höhenpunkten geladen")
(princ "\n(c) Dipl.-Ing. Volker Kleppel")
(princ "\nStand 16.04.2007")
(print)

;|«Visual LISP© Format Options»
(72 5 1 2 T "Ende von " 60 9 0 0 nil T nil nil T)
;*** KEINEN Text unterhalb des Kommentars hinzufügen! ***|;

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

-sauer
Mitglied
Zeichner


Sehen Sie sich das Profil von -sauer an!   Senden Sie eine Private Message an -sauer  Schreiben Sie einen Gästebucheintrag für -sauer

Beiträge: 314
Registriert: 01.03.2007

ACAD2012, MEP2012

erstellt am: 01. Apr. 2014 12:47    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Habs gefunden nach langem suchen...

einfach
      (arxload "geomcal.arx")
in
      (arxload "geomcal.crx")

ändern... dann geht wieder alles...

Gruß Danke

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

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2023 CAD.de | Impressum | Datenschutz