;*****************************************************************************
;HKATTS.lsp
;Benötigt HKATTS.dwg , Layer BEM
;(C) Copyright Konstruktionsbüro W. MEYER, D-85649 Otterloh,        16.12.2002       
;*****************************************************************************
(defun c:HKATTS (/ )
 (princ "\nH'koten setzen.  Starten mit HKATTS ")
;FEHLERBEHANDLUNGSROUTINE.....................................................
 (defun-q *error* (msg)
  (setvar "osmode" aosm) (setvar "blipmode" abli) (setvar "luprec" alup) (setvar "dimzin" azin)
  (setq p1 nil p2 nil p3 nil p4 nil c1 nil cy nil cym nil txt nil)
  (setq hkmz nil o_str nil n_str nil o_slen nil n_slen nil si nil st nil dx nil me nil cmmm nil cm1 nil cm2 nil mm1 nil mm2 nil txtme nil txtcm nil txtmm nil cym nil)
  (setq asatz nil len nil n nil e nil e1 nil)
  (setq o_str nil n_str nil o_slen nil n_slen nil si nil st nil)
  (if (= hk nil) (setq hk hkw) (setq hkw hk) )
  (princ msg)(princ)
 )
;SYSTEMVARIABLEN SETZEN.......................................................
 (while (or (= mxy nil)(= mxy 0)(= mxy 0.0))
  (setq mxy (getreal "\nDen Maßstab dieser Zeichnung eingeben  1:? "))
  (princ "\n\n\n")
 )
 (setq aosm (getvar "osmode"))
 (setq abli (getvar "blipmode"))
 (setq alup (getvar "luprec"))
 (setq azin (getvar "dimzin"))
 (setvar "cmdecho" 0)
 (setvar "osmode" 111)
 (HK-WAHL)
 (setvar "osmode" aosm) (setvar "blipmode" abli) (setvar "luprec" alup) (setvar "dimzin" azin)
 (princ)
)
;*****************************************************************************
(defun HK-WAHL (/ )
(if (or (= NPKT nil)(= NPKT "")) (HK-NPKT) (progn (HK-AKREUZ)(HK-BEZUG)) )
 (if (= hk nil) (setq hk "S" hkw hk) )
 (initget "B A S")
 (setq hk (getkword (strcat "\n(B)ezugspunkt ändern  (A)ktualisieren  (S)etzen  <" hk "> ?: ")) )
 (if (= hk "B")
  (progn
   (setq hk hkw) (HK-NPKT)
   (initget "B A S")
   (setq hk (getkword (strcat "\n(B)ezugspunkt ändern  (A)ktualisieren  (S)etzen  <" hk "> ?: ")) ) 
  )
 )
 (if (= hk "A")
  (progn
   (setq hk hkw) (HK-AKTUEL)
   (initget "B A S")
   (setq hk (getkword (strcat "\n(B)ezugspunkt ändern  (A)ktualisieren  (S)etzen  <" hk "> ?: ")) )
  )
 )   
 (if (= hk nil) (setq hk hkw) (setq hkw hk) )
 (if (= hk "S") (HK-SETZEN) )
 (setvar "osmode" aosm) (setvar "blipmode" abli) (setvar "luprec" alup) (setvar "dimzin" azin)
 (princ)
)
;*****************************************************************************
;BEZUGSPUNKT- BEZUGSWERT- FESTLEGEN...........................................
(defun HK-NPKT (/ )
 (command "_redraw")
 (princ "\n\n\n")
 (setq pxy nil)
 (while (or (= pxy nil)(= pxy ""))
  (setq pxy (getpoint "\nEinen Bezugspunkt für die H'koten wählen: "))
  (princ "\n\n\n")
 )
 (HK-AKREUZ)
 (setq py nil)
 (while (or (= py nil)(= py ""))
  (setq py (getreal "\nDer gewählte Bezugspunkt liegt auf welcher Höhe ?: ")) 
  (princ "\n\n\n")
 )
 (setq tpy py)						;für Bezugswert-Anzeige
 (setq NPKT (cadr pxy) NPKT (- NPKT py))
 (princ "\n\n\n\n")
 (HK-BEZUG)
 (princ)
)
;*****************************************************************************
;BEZUGSPUNKT-WERT ANZEIGEN....................................................
(defun HK-BEZUG (/ )
 (if (or (= py 0.0)(= py 0)) (setq tpy (strcat "+/-" (rtos py))) )
 (if (or (> py 0.0)(> py 0)) (setq tpy (strcat "+" (rtos py))) )
 (princ "\nDer aktuelle Bezugspunkt liegt auf: ")(princ tpy)
 (princ)
)
;*****************************************************************************
;ACHSKREUZ AM BEZUGSPUNKT ZEICHNEN............................................
(defun HK-AKREUZ (/ p1 p2 p3 p4)
 (setq p1 (list (car pxy) (cadr (getvar "VSMIN")) )
       p2 (list (car pxy) (cadr (getvar "VSMAX")) )
       p3 (list (car (getvar "VSMIN")) (cadr pxy) )
       p4 (list (car (getvar "VSMAX")) (cadr pxy) )
 )
 (grvecs (list -124 p1 p2 -124 p3 p4))
 (princ)
)
;*****************************************************************************
(defun HK-SETZEN (/ c1 cy cym txt)
 (princ "\n\nH'kote wird am gewählten Punkt eingefügt. ")
 (setvar "blipmode" 1)
 (while
  (setq c1 (getpoint "\nH'koten-Punkt wählen: ") )
  (setq cy (cadr c1) cy (- cy NPKT))
  (setq cym cy)
;***************GEÄNDERT
  (setq txt (rtos (/ cy 1000.0) 2 3))
;***************GEÄNDERT
  (if (or (= cym 0.0)(= cym 0)) (setq txt (strcat "+/-" txt)) )
  (if (or (> cym 0.0)(> cym 0)) (setq txt (strcat "+" txt)) )
  (command "_layer" "_ma" "BEM" "_c" "2" "" "" "_cecolor" "256" "_celtype" "bylayer" )
  (command "_-insert" "HKATTS" c1 mxy "" "" txt)
  (princ txt)
 )
 (princ)
)
;*****************************************************************************
;HK-AKTUEL.lsp.......................... .....................................
;AKTUALISIERT H'KOTEN-BLÖCKE auf den aktuellen Y-Wert des Einfügepunktes      
;Anhängende Texte werden entfernt: z.B. wird aus +1000 O.K.S. dann nur +1222      
(defun HK-AKTUEL (/ asatz len n c1 e cy txt e1)
 (command "_undo" "m")					;Zurück Markierung
 (if (= meld nil) (MELDSTA) )
 (princ "\n\n\nDas Programm aktualisiert die Werte gewählter H'koten. ")
 (setq asatz (ssget (list (cons 2 "HKATTS")))		;Blöcke HKATTS wählen
         len (sslength asatz)				;Länge Auswahlsatz
           n 0						;Anzahl Elemente im Auswahlsatz
 )
 (while (< n len)
  (setq e (entget (ssname asatz n)) )
  (setq c1 (cdr (assoc 10 e)) qe c1)			;Basis c1 = WKS xyz Koordinaten
  (setq c1 (trans c1 0 1))				;jetzt c1 = BKS xyz Koordinaten
  (setq cy (cadr c1) cy (- cy NPKT) )
  (setq cym cy)
  (setq txt (rtos cy))
  (if (or (= cym 0.0)(= cym 0)) (setq txt (strcat "+/-" txt)) )
  (if (or (> cym 0.0)(> cym 0)) (setq txt (strcat "+" txt)) )
  (setq e1 (entget (entnext (cdr (assoc -1 e)))) )
  (setq e1 (subst (cons 1 txt)(assoc 1 e1) e1) )
  (entmod e1)
  (entupd (cdr (assoc -1 e1)))
  (setq n (1+ n))
 )							;ende-while
 (princ "\n\n\n")
)							;ende-defun
;*****************************************************************************
;MELDUNG NUR BEIM START.......................................................
(defun MELDSTA (/ )
(alert "
\Auch von Hand geänderte Zahlen
\ ändern sich auf den Wert der
\      aktuellen Position"
)
(setq meld 1)
(princ)
)
;*****************************************************************************