;;; ------------------- TOOLS.LSP -------------------
;;;
;;; Einsatz:  AutoCAD / Genius allgemein
;;; Funktion: diverse
;;;
;;;
;;; (C) GROB-WERKE Mindelheim, Lisiecki Ch.
;;; Version V1.3
;;;                              Stand 23:20 21.03.97
;;; -------------------------------------------------

(defun c:TOOLS (/ action)
  (setq action 0)
  (setq scmde (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (d_menue)
  (cond
    ((= action 1) (c:blkanzahl))
    ((= action 2) (c:blkentf))
    ((= action 7) (c:blkscale))
    ((= action 3) (c:bereinig2))
    ((= action 4) (c:endd))
    ((= action 5) (c:txtboxed))
    ((= action 6) (c:makepart))
    (T (prompt "\nKeine Funktion ausgewählt"))
  )
  (setvar "CMDECHO" scmde)
  (princ)
)
; -------------------------------------------------
(defun d_menue ()
  (setq dcl_id (load_dialog "c:/tab11/lsp/tools.dcl")) ;Supportpfad
  (if (not (new_dialog "tools" dcl_id)) (exit))
  (action_tile "b_blkscale" "(setq action 7) (done_dialog)")
  (action_tile "b_blkanzahl" "(setq action 1) (done_dialog)")
  (action_tile "b_blkentf" "(setq action 2) (done_dialog)")
  (action_tile "b_bereinig2" "(setq action 3) (done_dialog)")
  (action_tile "b_finish" "(setq action 4) (done_dialog)")
  (action_tile "b_txtboxed" "(setq action 5) (done_dialog)")
  (action_tile "b_makepart" "(setq action 6) (done_dialog)")
  (action_tile "cancel" "(done_dialog)")
  (action_tile "accept" "(done_dialog)")
  (start_dialog)
  (unload_dialog dcl_id)

)

;;; -------------------------------------------------
;;; -------------------------------------------------
(defun C:BLKANZAHL (/ BNAM SS)
  (princ "Anzahl der eingefügten Blöcke")
  (setq BNAM(getstring"\nBlockname:")
        SS(ssget "X" (list(cons 2 BNAM))))
  (if(null SS)
    (prompt(strcat"\nKeine Einfügungen von " (chr 34)BNAM(chr 34)))
    (prompt(strcat"\nEs gibt insgesamt " (itoa(sslength SS))
       " Einfügungen von " (chr 34) BNAM(chr 34)))
  )
  (princ)
)
; -------------------------------------------------
(defun C:BLKENTF (/ BNAM SS)
  (princ "Löschen aller Einfügungen eines Blocks")
  (setq BNAM(getstring"\nBlockname:")
        SS(ssget "X" (list(cons 2 BNAM))))
  (if(null SS)
    (prompt(strcat"\nKeine Einfügungen von " (chr 34)BNAM(chr 34)))
    (prompt(strcat"\nSoll der Block " (chr 34) BNAM(chr 34)
    " " (itoa(sslength SS)) "-mal gelöscht werden?"))
  )
  (setq qjn (getstring " <j>/n ") )
  (if (or (= qjn "j") (= qjn "")) (command "_.erase" "_previous" ""))
  (princ)
)
; -------------------------------------------------
(defun C:BLKSCALE ()
  (initget "Koord Oberfl")
  (setq what (getkword "\nWelche Elemente skalieren <Koord.>/Oberfl. "))
  (prompt "\nElemente zum Skalieren auswählen ")
  (cond 
    ((= what "Oberfl")
      (setq ss1 (ssget '((0 . "INSERT")(-4 . "<or")(2 . "GEFROU4")(2 . "GEFROU5")(2 . "GEFROG4")(2 . "GEFROG5")(-4 . "or>") ) ))
      (if (not ss1) (princ "\nKeine Elemente ausgewählt")
        (progn
          (setq scale (getreal "\nSkalierung eingeben: "))
          (setq len (sslength ss1))
          (setq index 0)
          (repeat len
            (setq e_dat (entget (ssname ss1 index)))
            (command "_.SCALE" (ssadd (ssname ss1 index)) "" (fld 10) (rtos (/ scale (fld 41)) ))
            (setq index (1+ index))
          )
        )
      )
    )
    (T 
      (setq ss1 (ssget '((0 . "INSERT")(2 . "GENORD")) ))
      (if (not ss1) (princ "\nKeine Elemente ausgewählt")
        (progn
          (setq scale (getreal "\nSkalierung eingeben: "))
          (setq len (sslength ss1))
          (setq index 0)
          (repeat len
            (setq e_dat (entget (ssname ss1 index)))
            (setq e_dat (subst (cons 41 scale) (assoc 41 e_dat) e_dat))
            (setq e_dat (subst (cons 42 scale) (assoc 42 e_dat) e_dat))
            (setq e_dat (subst (cons 43 scale) (assoc 43 e_dat) e_dat))
            (entmod e_dat)
            (setq index (1+ index))
          )
        )
      )
    )
  )
)

;;; -------------------------------------------------
;;; -------------------------------------------------
(defun C:BEREINIG2 (/ done)
  (setq done T)
  (command "_.purge" "_a" )
  (while (= (getvar "CMDNAMES") "PURGE")
    (command "_y" )
    (setq done nil)
  )
  (if (not done) (C:BEREINIG2))
  (princ)
)
; -------------------------------------------------
(defun C:ENDD ( / ss1 set_rev more e1 e2 e_dat)
  (command "_.LAYER" "_OFF" "9,9N,VIEW"
                     "_F"   "9,9N,VIEW" "")
  (command "_.LAYER" "_ON" "0,1,2,3,3A,4,4A,5,6,7,7A,8,0N,1N,2N,3N,3AN,4N,4AN,5N,6N,7N,7AN,8N" 
                     "_T"  "0,1,2,3,3A,4,4A,5,6,7,7A,8,0N,1N,2N,3N,3AN,4N,4AN,5N,6N,7N,7AN,8N" "")
  (command "_.LAYER" "_S" "0" "")
  (setq ss1 (ssget "X" '((8 . "KLIN"))))
  (if ss1
    (command "_.ERASE" ss1 "")
  )
  (C:BEREINIG2)
  (setvar "TILEMODE" 1)
  (command "_.ZOOM" "_E")
  (command "_.ZOOM" "0.8x")
  (setvar "TILEMODE" 0)
  (initget "Nein Ja")
  (setq set_rev (getkword "Revisionsstand erhöhen? <N>/J :"))
  (setq e1 (entnext))
  (while (setq e1 (entnext e1))
    (setq e_dat (entget e1))
    (if (and (= (fld 0) "INSERT") (= (fld 66) 1))
      (progn
        (setq e2 e1
              e1 (entnext e1)
              more T)
        (while more
          (setq e_dat (entget e1))
          (cond 
            ((= (fld 0) "ATTRIB") (fillatt) (setq e1 (entnext e1)))
            ((= (fld 0) "SEQEND") (setq more nil))
            (T (setq e1 (entnext e1)))
          )
        )
      )
    )
  )
;  (entupd e2) ; nicht nötig, da REGEN nachfolgend ausgefuehrt wird
  (command "_.ZOOM" "_E")
  (command "_.QSAVE")
)
(defun fillatt (/ cdate)
  (setq cdate (rtos (getvar "CDATE") 2 6)
        cdate (strcat (substr cdate 7 2) "." (substr cdate 5 2) "." (substr cdate 3 2)))
  (setq attag (fld 2))
  (cond
    ((= attag "GEN-TITLE-NAME{5}") (f_attmod (getvar "LOGINNAME")))
    ((= attag "GEN-TITLE-DWG{30}") (f_attmod (getvar "DWGNAME")))
    ((= attag "GEN-TITLE-PLOT{2.94}") (f_attmod cdate))
    ((and (= attag "R") (= set_rev "Ja")) (f_attmod (itoa (+ 1 (atoi (fld 1)))) ) )
  )
)
(defun f_attmod (att)
  (setq e_dat (subst (cons 1 att) (assoc 1 e_dat) e_dat))
  (entmod e_dat)
)
(defun fld (num)
  (cdr (assoc num e_dat))
)

; -------------------------------------------------
; -------------------------------------------------
(defun C:TXTBOXED (/ center string above below right left)
  (princ)
  (setq THGT (getvar "TEXTSIZE"))
  (prompt "\nZeichnet einen Rahmen um eine Zeichenkette")
  (setq center (getpoint "\nMittelpunkt des Rahmens"))
  (setq THGT (getdist (strcat "\nTexthöhe <" (rtos THGT) ">:")))
  (if (= thgt nil) (setq thgt (getvar "textsize")))
  (setq string (getstring T "\nText eingeben : "))
  (setq lgth (strlen string)
        ontop (+ (cadr center) (* 0.9 THGT))
        under (- (cadr center) (* 0.9 THGT))
        right (+ (car center) (* 0.5 (* THGT lgth)))
        left (- (car center) (* 0.5 (* THGT lgth))))
  (command "_.PLINE" (list left under) "_W" "0" "0" 
                     (list right under) (list right ontop) (list left ontop) "_C")
(command "_.TEXT" "_M" center THGT "0" string
)
(princ)
)

;;; -------------------------------------------------
;;; -------------------------------------------------
(defun C:MAKEPART ( ;|/ fname lname file count path|;)
  (setvar "cmdecho" 0)
  (setq base "5000,5000,0")
  (setq path (getstring "\nPfad für DXF-Dateien, Format: d:\\TEMP\\  <akt.>: "))
  (command "sh" (strcat "dir " path "*.dxf /b > c:\\temp.$$$" ))
  (setq file (open "C:\\temp.$$$" "r"))
  (if file
    (progn
      (while (setq lname (read-line file))
        (if (not (member (substr lname 1 1) '("" " " ".")))
          (progn
            (setq count 1)
            (while (/= (substr lname count 1) ".")
              (setq count (1+ count))
            )
            (setq lname (substr lname 1 (1- count)))
            (prompt (strcat "\nWorking...\t" path lname ".dxf"))
            (command "_.erase" (ssget "X")) ; evtl "" hinzu
            (command "_.dxfin" (strcat path lname))
            ; evtl. Mach Layer PART
            (command "eigändr" (ssget "X") "" "LA" "PART" "")
            (command "_.zoom" "_e")
            (command "_.mslide" (strcat path lname) )
            (command "_.wblock" (strcat path lname) "" base "alle" "")
            ;(command "shell" (strcat "del " (strcat path dxfname) ".dxf"))
          )
        )
      )
    )
  )
  (close file)
  ;(command "sh" "del temp.$$$")
  (setvar "cmdecho" 1)
  (prompt "\n Alle Dateien im angegebenen Pfad bearbeitet.")
  (princ)
)

;;; -------------------------------------------------
;;; -------------------------------------------------
(princ)
(prompt "\n---------------------------------------------")
(prompt "\nTOOLS geladen ... by Lisiecki Ch.")
(prompt "\nZeichnung abschliessen auch mit ENDD moeglich")
(princ)