;Norbert Baum
;www.norbi-net.de
;programmieren@norbi-net.de
;
;
;mit viel Unterstützung aus dem CAD.de Forum
;vorallem von CADmium
;
;(load ".\\init.lsp") ;;Elemente Liste
;(load ".\\func.lsp")

;;c:blocknamen - siehe func.lsp

;;init.lsp
;;--------------------------------------------------------------------------------------------------
;;ElementeListeAll
;;definiert alle Blocknamen, die Multilift als Elemente hat
;;HIER DARF und SOLL geändert werden
;;(cons "name" wert) - Es ist egal an welcher Stelle das steht
;;--------------------------------------------------------------------------------------------------
(setq ElementeListeAll 
  (list
   (cons "HEM400" 8)
   (cons "HEM500_3000" 4)
  )
)
;;--------------------------------------------------------------------------------------------------
;;ab HIER nichts mehr ändern!!!!
;;--------------------------------------------------------------------------------------------------
;;--------------------------------------------------------------------------------------------------
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;--------------------------------------------------------------------------------------------------
;;ElementeListeDWG wird initialisiert und initDWG wird auf 0 gesetzt, beim Prorgamm starten
;;--------------------------------------------------------------------------------------------------
(setq ElementeListeDWG '())
;;--------------------------------------------------------------------------------------------------
;;initDWG wird auf 0 gesetzt (beim Programm start / laden[appload])
;;--------------------------------------------------------------------------------------------------
(setq initDWG 0)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;IB.lsp
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq inDWG nil)
(defun init (blname / )
  (setq ElementeListeDWG (copyListe ElementeListeAll))
 ;; vorher bereinigen
  (setq inDWG (blocknamen))
  (setq ElementeListeDWG (1plus inDWG ElementeListeDWG))
  ;;blname hochzählen
  (insert blname)
  (setq initDWG 1)
)

(defun insert (blname / )
  (if (null (pluswenn blname))
    "nix"
    "abbruch"
    )
  )
  
 
(defun blinsert (blname / )
  ;(setq blname (cdr(assoc 2 (entget (entlast)))))
  ;(alert blname)
  (cond
    ((= initDWG 0) (init blname))
    ((= initDWG 1) (insert blname))
    (T
     "Fehler")
  )
)
  
;aus CAD.de Forum
; Funktion zum Setzen der Reaktoren
(defun add-cmd-reactors( / )
  (vl-load-com)
  (if(not *cmd-reactor-added*)
    (progn
      (vlr-command-reactor nil
       '( (:vlr-commandWillStart . cmd-start-callback))
      )
      (vlr-command-reactor nil
       '( (:vlr-commandEnded . cmd-end-callback))
      )
      (setq *cmd-reactor-added* 'T)
    )
  )
)


;;--------------------------------------------------------------------------------------------------
;;Reactor - Einfügen - Anfang
;;--------------------------------------------------------------------------------------------------
; allgemeine Cmd-Callback-Funktion
; (vor der Befehlsausführung)
(defun cmd-start-callback(reactor argslist / )
  ;(print argslist); - Ausgabe, der Befehle, die ausgeführt werden/wurden
  (cond
    ( (member(car argslist)'("ACDCINSERTBLOCK""DROPGEOM"))
     (alert "VORHER")

     (setq blname (cdr(assoc 2 (entget (entlast)))))
   ;  (alert blname)
    (blinsert blname) 
     ;Funktion die ausgeführt werden soll (dim-start-callback reactor argslist)
     ;
     ;Blockname an ARX übergeben
     ;ARX-Funktion Starten und Blockname mit nehmen
     ;in ARX auswerten/Zählen etc
     ;auf true/false von ARX reagieren mit Abruch oder einfügen
     ;
     ;
     (alert (vla-get-activedocument (vlax-get-acad-object)))
    )
    ( (=(car argslist)"BHATCH")
      (bhatch-start-callback reactor argslist)
    )
  )
)

; allgemeine Cmd-Callback-Funktion
; (nach der Befehlsausführung)
(defun cmd-end-callback(reactor argslist / )
  (cond
    ( (member(car argslist)'("ACDCINSERTBLOCK""DROPGEOM"))
     (alert "NACHHER")
      ;Funktion die ausgeführt werden solls (dim-end-callback)
    )
    ( (=(car argslist)"BHATCH")
      (bhatch-end-callback)
    )
  )
)
;;--------------------------------------------------------------------------------------------------
;;Reactor - Einfügen - Ende
;;--------------------------------------------------------------------------------------------------




; Sicherstellen, dass die ActiveX-
; Funktionen geladen sind
(vl-load-com)
; Reaktoren beim Laden starten
(add-cmd-reactors)




;;;;func.lsp
;;teilweise aus cad.de Forum oder Markus Ullrich
;;--------------------------------------------------------------------------------------------------
;;blocknamen - liefert eine Liste mit allen Blocknamen zurück!
;;--------------------------------------------------------------------------------------------------
(defun blocknamen(/ BLOCK)
  (setq LISTE nil)
  (While (setq BLOCK(tblnext "BLOCK" (null BLOCK)))
    (setq LISTE (cons
		  (cdr(assoc 2 BLOCK))
		  LISTE))
  )
  LISTE
)
;;--------------------------------------------------------------------------------------------------
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;--------------------------------------------------------------------------------------------------
;;copyListe - liefert eine Liste, wo die Elementewerte 0 sind
;;--------------------------------------------------------------------------------------------------
(defun copyliste (all /)
  (if (= (type all) 'LIST)
    (mapcar
      '(lambda (X) (cons (car X) 0))
      all
    )
  ) 
)
;;--------------------------------------------------------------------------------------------------
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;--------------------------------------------------------------------------------------------------
;;plusmöglich?
;;pluswenn -liefert #f oder nil zurück
;;--------------------------------------------------------------------------------------------------
;(define DWG '(("aname" 5)("bname" 6) ("blname" 1)))
;(define ALL '(("aname" 5)("bname" 6) ("blname" 2)))
(defun plusmöglich? (blstring bldwg blall /)
    (cond
      ((null bldwg) nil)
      ((not (element? blstring bldwg)) T)
      ((and (equal blstring (caar bldwg)) (< (cadar bldwg) (cadar blall))) T)
      (T
       (plusmöglich? blstring (cdr bldwg) (cdr blall)))))
;;;-------
(defun pluswenn (blstring /)
    (if (plusmöglich? blstring ElementeListeDWG ElementeListeAll)
        (setq ElementeListeDWG (1plus (list blstring) ElementeListeDWG)) 
        nil))
;;--------------------------------------------------------------------------------------------------
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;--------------------------------------------------------------------------------------------------
;;1plus - Anfang
;;--------------------------------------------------------------------------------------------------
;(1plus '("a" "b" "c" "b" "c") '(("a" 5)("c" 5)("b" 5)))
;;edit by Markus Ullrich
(defun 1plus (bltab bldwg /)
  (cond
    ((null bltab) bldwg)
    ((element? (car bltab) bldwg) (1plus (cdr bltab) (plus1 (car bltab) bldwg bltab)))
    (T
     (1plus (cdr bltab) bldwg))))

;;write by Markus Ullrich
(defun plus1 (element bldwg bltab /)
    (cond
      ((null bldwg) ())
      ((element? element (car bldwg)) (cons (ersetze (cadar bldwg) (car bldwg) (+ (cadar bldwg) 1)) (cdr bldwg)))
      (T
       (cons (car bldwg) (plus1 element (cdr bldwg) bltab)))))

;aus dem Lambda-Kalkül von C. Wagenknecht (HS Zittau/Görlitz)
(defun ersetze (var1 ausdr var2 /)
    (cond
      ((not (listp ausdr)) (if (equal ausdr var1) var2 ausdr))
      ((null ausdr) ())
      ((listp (car ausdr)) (cons (ersetze var1 (car ausdr) var2) (ersetze var1 (cdr ausdr) var2)))
      (T
       (if (equal (car ausdr) var1) (cons var2 (ersetze var1 (cdr ausdr) var2))
           (cons (car ausdr) (ersetze var1 (cdr ausdr) var2))))))

(defun element? (var ausdr /)
    (cond
      ((not (listp ausdr)) (if (equal ausdr var) T nil))
      ((null ausdr) nil)
      ((listp (car ausdr)) (or (element? var (car ausdr)) (element? var (cdr ausdr))))
      (T
       (if (equal (car ausdr) var) T (element? var (cdr ausdr))))))
;;--------------------------------------------------------------------------------------------------
;;1plus - Ende
;;--------------------------------------------------------------------------------------------------