; ----------------------------------------------------------------------
;                 B E M A S Z U N G S H I L F E
; ......................................................................
; Anwendung auf assoziative Bemaszung
; Diese wird in Fuss und Inch umgerechnet, indem der Text aus der
; Maszkette in die andere Einheit transformiert wird. Der ermittelte
; Wert wird unterhalb der Maszlinie auf dem Layer Inch angeordnet
; Aufruf:
;	BemInch		Maszketten anklicken
;	InchGenau	Basis fuer Rundung eingeben (16 heisst z.B. 1/16)
;	metrischeEinheit aktuelle Einheiten sind m, cm oder mm
;
; ----------------------------------------------------------------------
(defun C:InchGenau ( / Wahl)
  (initget "1 2 4 8 16 32 64 128 256")
  (setq Wahl (getkword "\nBasis eingeben: 1, 2, 4, 8, 16, 32, 64, 256  "))
  (if (= Wahl   "1")  (setq Genauigkeit 0))
  (if (= Wahl   "2")  (setq Genauigkeit 1))
  (if (= Wahl   "4")  (setq Genauigkeit 2))
  (if (= Wahl   "8")  (setq Genauigkeit 3))
  (if (= Wahl  "16")  (setq Genauigkeit 4))
  (if (= Wahl  "32")  (setq Genauigkeit 5))
  (if (= Wahl  "64")  (setq Genauigkeit 6))
  (if (= Wahl "128")  (setq Genauigkeit 7))
  (if (= Wahl "256")  (setq Genauigkeit 8))
  (princ)
)
; ----------------------------------------------------------------------
(defun C:metrischeEinheit ( / Wahl)
  (initget "mm cm meter")
  (setq Wahl (getkword "\nBasis eingeben: mm cm meter  "))
  (if (= Wahl  "mm")    (setq mEinheit    1.0))
  (if (= Wahl  "cm")    (setq mEinheit   10.0))
  (if (= Wahl  "meter") (setq mEinheit 1000.0))
  (princ)
)
; ----------------------------------------------------------------------
(defun C:inchOberhalb ()
  (if inchOberhalb 
     (setq inchOberhalb nil)
     (setq inchOberhalb T)
  )
)
; ----------------------------------------------------------------------
(defun C:BemInch ( / AS Lauf elist ElistX ENameX)
  (if (not Genauigkeit) (C:InchGenau))
  (if (not mEinheit)    (C:metrischeEinheit))

  (if (not Genauigkeit) (setq Genauigkeit 4))
  (if (not mEinheit)    (setq mEinheit  1.0))

  (setq AS (ssget (list (cons 0 "DIMENSION"))))
  (if (not AS) (progn
     (exit)
  ))
  (setq Lauf -1)
  (while  (setq ename (ssname AS (setq Lauf (1+ Lauf))) )
    (setq elist (entget ename))
    (setq dimEnt (tblsearch "BLOCK" (cdr (assoc 2 elist))))
    (setq dimEName (cdr (assoc -2 dimEnt)))
    (setq ENameX dimEName)
    (while ENameX
       (setq EListX (entget ENameX))
       
       (if (= (cdr (assoc 0 ElistX)) "MTEXT") (makeInchEntity ElistX) )
       (if (= (cdr (assoc 0 ElistX)) "TEXT")  (makeInchEntity ElistX) )
       (setq ENameX (entnext ENameX))
    )
  ); while
  (setq AS nil) (gc) (princ)
)
; ----------------------------------------------------------------------
(defun C:TxtInch ( / AS Lauf elist ElistX ENameX)
  (if (not Genauigkeit) (C:InchGenau))
  (if (not mEinheit)    (C:metrischeEinheit))

  (if (not Genauigkeit) (setq Genauigkeit 4))
  (if (not mEinheit)    (setq mEinheit  1.0))

  (setq AS (ssget (list (cons 0 "TEXT"))))
  (if (not AS) (progn
     (exit)
  ))
  (setq Lauf -1)
  (while  (setq ename (ssname AS (setq Lauf (1+ Lauf))) )
    (setq EListX (entget ename))
    (if (= (cdr (assoc 0 ElistX)) "TEXT") (makeInchEntity ElistX) )
  ); while
  (setq AS nil) (gc) (princ)
)
; ----------------------------------------------------------------------
(defun makeInchEntity (ElistX)

     (print "makeInchEntity")

     (if (= (cdr (assoc 0 ElistX)) "MTEXT") 
       (progn
         (setq chrMaszZahl (cdr (assoc 1 ElistX)))
         (if (= (substr chrMaszZahl 1 1) "\\")
            (progn
	       (setq MaszZahl (substr (strchr chrMaszZahl ";") 2))
	       (setq iPos (istrchr MaszZahl ","))
	       (if (> iPos 0) (progn
	          (setq dmMaszZahl MaszZahl)
	          (setq MaszZahl (strcat (substr dmMaszZahl 1 (1- iPos)) "." (substr dmMaszZahl (1+ iPos))))
	       )); progn if
               (print MaszZahl)
	    ) ; progn
         ); if
       ); progn
       (setq MaszZahl (cdr (assoc 1 ElistX)))
     ); if

;    (setq MaszZahl (cdr (assoc 1 ElistX)))

     (setq inMillim (* mEinheit (read MaszZahl)))

     (setq inMeter  (/ (float inMillim) 25.4))
     (setq inInch (rtos inMeter 4 Genauigkeit))
     ; -- ohne Null formatieren
     (if (> inMeter 12.0) (setq inInch (inchformat inInch)))
     ; -- Klammer um den Inch-Text
     (setq inInch (strcat "(" inInch ")"))
     ; -- Plazierung des Inch-Textes
     (setq Wnkl (cdr (assoc 50 ElistX)))
     (setq nWnkl (- Wnkl (/ PI 2.0)))
     (setq Abst (cdr (assoc 40 ElistX)))
     (setq Abst (* 2.0 Abst))
     ; -- Punktkoordinaten
     (setq P1 (cdr (assoc 10 ElistX)))
     (setq PN1 (polar P1 nWnkl Abst))
     (setq P2 (cdr (assoc 11 ElistX)))
     (setq PN2 (polar P2 nWnkl Abst))
     (setq newEnt (cdr ElistX))
    
     (setq newEnt (subst (cons 1 inInch)   (assoc  1 newEnt) newEnt))
     (setq newEnt (subst (cons 8 "inches") (assoc  8 newEnt) newEnt))
     (setq newEnt (subst (cons 10 PN1)     (assoc 10 newEnt) newEnt))
     (setq newEnt (subst (cons 11 PN2)     (assoc 11 newEnt) newEnt))

     (if inchOberhalb (progn
       (setq ElistX (subst (cons 10 PN1) (assoc 10 ElistX) ElistX))
       (setq ElistX (subst (cons 11 PN2) (assoc 11 ElistX) ElistX))
       (entmod ElistX)
       (setq newEnt (subst (cons 10 P1)  (assoc 10 newEnt) newEnt))
       (setq newEnt (subst (cons 11 P2)  (assoc 11 newEnt) newEnt))
     ))

     (setq xxEnt (entmake newEnt))
)
; ----------------------------------------------------------------------
(defun inchFormat (inchTxt / Lauf)
   (setq Lauf 2)
   (while (/= (substr inchTxt Lauf 1) "'") (setq Lauf (1+ Lauf)))
   (if (< Lauf (strlen inchTxt)) (progn
      (setq Lauf (1+ Lauf))
      (if (= (substr inchTxt Lauf 2) "-0")
        (setq inchTxt (strcat 
	     (substr inchTxt 1 Lauf) (substr inchTxt (+ Lauf 2))
        )); strcat - setq
        (setq inchTxt inchTxt)
      )
    ); progn - if
    (progn ; else
        (setq inchTxt inchTxt)
    ); progn - else
   ); if
)
; ======================================================================
(defun strchr (text chr / i)
     (setq i 0)
;    (while (/= (substr text (setq i (1+ i)) 1) chr))
     (while (and (< i (strlen text)) (/= (substr text (setq i (1+ i)) 1) chr)))

     (setq rText (substr text  i ))
)
; ====================================================================== 
(defun istrchr (text chr / i)
     (setq i 0)
     (while (and (< i (strlen text)) (/= (substr text (setq i (1+ i)) 1) chr)))
     (if (> i (strlen text)) (setq i -1))
     (setq i i)
)
; ======================================================================