; Programm zur Flächenermittlung
; Das Programm ist Freeware - 
; Der Autor (Ernst Dietrich) übernimmt daher keinerlei Haftungen.
; Die Benutzung erfolgt auf eigene Gefahr !
; 28.08.2003:  Es wurden kleinere Korrekturen vorgenommen
;
; ÄNDERUNGEN DURCH KODAT
; Nachkommastellen = 2 
; Layer getauscht von flaech auf A_BB_TEXT_Raunflächen
; Aenderungen durch spider
; Layer fuer text variabel (layer_ausgabe)
; Ein- Ausgabeeinheiten abgefragt
;


(defun c:ff (/ pkt apkt p1 dist anfragetxt)
  (command "_.UNDO" "_END")
  (command "_.UNDO" "_GROUP")
  (setvar "PLINETYPE" 2)
  (setq olderr *error*)
  (setq *error* ederr)
  (setq vorlay (getvar "CLAYER"))
 ;
 ;Beginn Hinzufuegung abfragen Einheiten und Ausgabelayer
 ; 
; 1. alles Umrechnen auf m2
  (setq zeichnen_einheit (getstring "Zeichnungseinheit angeben (m/cm/<mm>) "))
  (if (= zeichnen_einheit "m")
    (setq faktor_1 1.0)
    (if (= zeichnen_einheit "cm")
        (setq faktor_1 (/ 1.0 10000.0))
        (setq faktor_1 (/ 1.0 1000000.0 zeichnen_einheit "mm"))
    )
  )
  ; 2. alles Umrechnen von m2
  (setq ausgabe_einheit (getstring "Ausgabeeinheit angeben (m2/cm2/<mm2>) "))
  (if (= ausgabe_einheit "m2")
    (setq faktor_2 1.0)
    (if (= ausgabe_einheit "cm2")
        (setq faktor_2 10000.0)
        (setq faktor_2 1000000.0 ausgabe_einheit "mm2")
    )
  )
  (setq faktor (* faktor_1 faktor_2))
  (setq layer_ausgabe (getstring "Name des Datenausgabe-Layers "))
 ;
 ; Ende Hinzufuegung abfragen Einheiten und Ausgabelayer
 ;
  (if (not konf)
    (flkonfig)
  )
  (if (not komst)
    (rundg)
  )
  (setq pkt T)
  (eingab)
  (while pkt
    (if umf
      (progn
        (if (not (= pkt "Objekt"))
          (flsolid)
        )
        (setq anfragetxt (strcat "\nFläche = " (rtos A_BB_TEXT_Raunflächen) " / " (rtos A_BB_TEXT_Raunflächen 2 komst) 
                                        " " zeichnen_einheit " - Beschriften: Nein=Enter/<<Textmitte>> ")
        )  ;  feste Einheit durch variable ersetzt
        (if (= 'LIST (type (setq einfpkt (getpoint anfragetxt))))
          (beschr)
        )
        (if (= pkt "Objekt")
          (progn
            (redraw umf 4)
            (command "_.ERASE" sol "")
          )
          (command "_.ERASE" umf sol "")
        )
      )
    )
    (eingab)
  )
  (command "CLAYER" vorlay)
  (command "_.UNDO" "_END")
  (princ)
)
;-------------------------------------------------------------------------
(defun eingab ()  ;Eingabe einer Option oder Punkt in der Fläche
  (osm0)
  (initget 128 "Objekt Umfahrung Konfig Rundg")
  (setq pkt (getpoint "\nObjekt/Umfahrung/Konfig/Rundung/<<Punkt für automatisch:>> "))
  (osmz)
  (cond
    ((= pkt "Objekt") (objekt-berech))
    ((= pkt "Umfahrung") (umf-berech))
    ((= pkt "Konfig")
      (flkonfig)
      (eingab)
    )
    ((= pkt "Rundg")
      (rundg)
      (eingab)
    )
    (pkt (pkt-berech))
  )
)
;-------------------------------------------------------------------------
(defun rundg ()   
  (if (not (setq komst (getint "\nFlächentext runden auf wieviele Kommastellen: <2> ")))
    (setq komst 2)
  )
)
;-------------------------------------------------------------------------
(defun objekt-berech (/ obj)
  (setq obj (entsel "\nPolylinie oder Kreis wählen: "))
  (setq umf (car obj))
  (redraw umf 3)
  (command "_.AREA" "O" obj)
)
;-------------------------------------------------------------------------
(defun umf-berech (/ anfragetxt) ;Umfahrung 
  (setq pkt (setq p1 (getpoint "\nErster Punkt: ")))
  (command "_PLINE" p1)
  (while (setq pkt (getpoint pkt "\nNächster Punkt: <Schliessen> "))
    (osm0)
    (command pkt)
    (if pkt
      (progn
        (setq dist (distance p1 pkt))
        (princ (strcat "\nEntfernung= "(rtos dist 2 2) " m"))
        (setq p1 pkt)
      )
    )
    (osmz)
  )
  (command "S")
  (setq umf (entlast))
  (flsolid)
  (command "_.AREA" "O" umf)
  (setq A_BB_TEXT_Raunflächen (getvar "AREA"))
  (setq anfragetxt (strcat "\nFläche = " (rtos A_BB_TEXT_Raunflächen) " / " (rtos A_BB_TEXT_Raunflächen 2 komst) 
                           " " zeichnen_einheit " - Beschriften: Nein=Enter / <<Textmitte>> ")
  )  ;  feste Einheit durch variable ersetzt
  (if (= 'LIST (type (setq einfpkt (getpoint anfragetxt))))
    (beschr)
  )
  (command "_.ERASE" umf sol "")
  (eingab)
)
;----------------------------------------------------------------------
(defun pkt-berech (/ lastnach lastvor)
  (load "c:/temp/VORAUSW")
  (vorauswahl)
  (command "_LAYER" "_T" "0" "")
  (command "CLAYER" 0)
  (setq lastvor (entlast))
  (command "_boundary" "O" "U" "N" aws "" "X" pkt "")
  (setq lastnach (entlast))
  (if (equal lastvor lastnach)
    (progn
      (setq umf nil)
      (setq A_BB_TEXT_Raunflächen "")
      (alert "Keine gültige Umgrenzung gefunden")
    )
    (progn
      (setq umf (entlast))
      (redraw umf 3)
      (command "_.AREA" "O" umf)
      (setq A_BB_TEXT_Raunflächen (getvar "AREA"))
    )
  )
)
;----------------------------------------------------------------------
(defun flsolid (/ counter lay)        ;zeigt die gefundene Fläche durch ein temporäres Solid an
  (if (not aws)                        ; wenn Auswahlsatz "aws" nicht existiert
    (progn                                
      (setq aws (ssadd))            ; erstelle den Auswahlsatz "aws" neu und
      (ssadd (entlast) aws)        ; füge das zuletzt erstellte Objekt hinzu.
    )
  )
  (command "REGENAUTO" 0)
  (setq lay "flsolid")
  (if (tblsearch "layer" lay)
    (command "_layer" "_s" lay "")
    (command "_layer" "m" lay "fa" "251" ""  "")
  )
  (command "_HATCH" "solid" umf "")
  (setq sol (entlast))
  (command "_draworder" "L" "" "N" (ssname aws 0))        ;das letzte Objekt wird unter die erste Grenze gelegt.
  (entupd sol)
  (setq counter 0)
  (repeat (sslength aws)
    (entupd (ssname aws counter))
    (setq counter (1+ counter))
  )
  (command "REGENAUTO" 1)
  (command "CLAYER" vorlay)
)
;----------------------------------------------------------------------
(defun beschr (/ txt)
;  (command "_.ERASE" umf sol "")
;
;  hier Augabelayer machen / wenn vorhanden setzen 
;
  (if (not (tblsearch "layer" layer_ausgabe)) ;  feste Layerbezeichnung durch variable ersetzt
    (command "_LAYER" "_M" layer_ausgabe "_C" "82" "" "")  ; dto.
    (command "CLAYER" layer_ausgabe)  ; dto.
  )
;  (setq txt (strcat (rtos A_BB_TEXT_Raunflächen 2 komst) " m2"))
  (setq A_BB_TEXT_Raunflächen (* A_BB_TEXT_Raunflächen faktor)) ; Umrechnung zeicheneinheit in ausgabeeinheit
  (setq txt (strcat (rtos A_BB_TEXT_Raunflächen 2 komst) " " ausgabe_einheit))  ; feste Angabe Ausgabeeinheit durch variable ersetzt

  (command "_.TEXT" "s" "Standard" "_J" "MZ" einfpkt 20 (+ (vt) 0) txt)  ;den Wert 0  entsprechend korrigieren

)
;----------------------------------------------------------------------
(defun ederr (s)
  (print s)
  (command "_.ERASE" umf sol "")
  (setq *error* olderr)
)
;----------------------------------------------------------------------
;diese Funktion fragt um Objekte, deren Layer wiederum als Filter für die Flächenberechnung
;verwendet werden. Mit den Layernamen wird das LSP-File VORAUSW erzeugt, welches dann
;die Objekte zur Flächenberechnung auswählt.

(defun flkonfig ()
  (initget 128 "Wie")
  (setq obj (nentsel "\nWelche Layer - Objekte anklicken/Wie bisher: <Voreinstellung> "))
  (cond
    ((= obj "Wie") (princ "\nBisherige Layer werden verwendet"))
    ((not obj) (stdard))        ;Layer laut Voreinstellung
    (obj (neuausw))
  )
  (setq konf T)
)
;----------------------------------------------------------------------
(defun neuausw (/ laynam lspfile)   ;Layer anklicken
  (setq lspfile (open "c:\\temp\\vorausw.lsp" "w"))
  (princ "(defun vorauswahl ()\n" lspfile)
  (princ "  (setq aws (ssget \"X\"\n" lspfile)
  (princ "    '((-4 . \"<or\")" lspfile)
  (while obj
    (princ "\n      " lspfile)
    (prin1 (cons 8 (setq laynam (cdr (assoc 8 (entget (car obj)))))) lspfile)
    (print laynam)
    (setq obj (nentsel "\nWelche Layer berücksichtigen - Objekte anklicken: "))  )
  (princ "\n    (-4 . \"or>\"))" lspfile)
  (princ "\n  ))" lspfile)
  (princ "\n)" lspfile)
  (close lspfile)
)
;----------------------------------------------------------------------
(defun stdard (/ lspfile)  ;Default-Layer
  (setq lspfile (open "c:\\temp\\vorausw.lsp" "w"))
  (princ "(defun vorauswahl ()\n" lspfile)
  (princ "  (setq aws (ssget \"X\"\n" lspfile)
  (princ "    '((-4 . \"<or\")" lspfile)
  
; hier können die Layer für die Voreinstellung eingetragen werden - jetzt nur "0", Layer "abc" und "def" vorbereitet
  (princ "\n      " lspfile) (prin1 (cons 8 "0") lspfile)
;  (princ "\n      " lspfile) (prin1 (cons 8 "abc") lspfile)
;  (princ "\n      " lspfile) (prin1 (cons 8 "def") lspfile)

  (princ "\n    (-4 . \"or>\"))" lspfile)
  (princ "\n  ))" lspfile)
  (princ "\n)" lspfile)
  (close lspfile)
)
;----------------------------------------------------------------------
(defun osm0 ()
  (setq osm (getvar "osmode"))
  (setvar "OSMODE" 0)
)
;------------------------------------------------------------------------------
(defun osmz ()
  (setvar "OSMODE" osm)
)
;----------------------------------------------------------------------
(defun vt ()
  (cvunit (getvar "viewtwist") "radiant" "neugrad")
)

;XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

(princ "\nStart mit   ff   ")