;;;   Programm:      ACM-BKSSPEICHERN.LSP
;;;   Befehlsaufruf: ACM-BKSSPEICHERN
;;;   Funktion:      Aktuelles BKS speichern
;;;   Autor:         Gerhard Rampf
;;;                  Kundenspezifische Anpassungen für AutoCAD und ZWCAD
;;;                  Liebigstr. 3 A
;;;                  86399 Bobingen
;;;                  E-Mail: rampf@geracad.de
;;;   Datum:         06.07.2025
;;;   Plattform:     Alle AutoCAD-Versionen ab Version 2005
(defun c:acm-bksspeichern ( / bks43 bks44 kbs01 kbs02 kbs03 kbs04 kbs05 kbs06 kbs07 kbs08 kbs09 kbs10 kbs11 kbs13 kbs14 kbs15)
(defun kbs01 ( / bks13 bks11 bks12)
(if
(and
(setq bks11 (kbs11))
(setq bks12 (open bks11 "w")))
(progn
(setq bks13
(list
"warn"
":dialog{key=\042t_1\042;"
":spacer{height=0.1;}"
":row{"
":image{alignment=top;color=dialog_background;key=\042i_1\042;width=5.5;height=2.7;fixed_width=true;fixed_height=true;}"
":spacer{width=0.05;}"
":text{alignment=top;key=\042t_2\042;width=32;"
(nth (getvar "EXTNAMES") (list "height=8.4;" "height=7.4;"))
"fixed_width=true;fixed_height=true;}}"
":row{"
":spacer{width=5;}"
":button{label=\042OK\042;key=\042b_1\042;width=13;fixed_width=true;is_cancel=true;}"
":spacer{width=5;}}}"))
(while bks13
(write-line (car bks13) bks12)
(setq bks13 (cdr bks13)))
(setq bks12 (close bks12))
bks11)
nil))
(defun kbs02 (bks01 / )
(if bks38 (vl-catch-all-apply 'setvar (list "CMDECHO" bks38)))
(if bks44 (setq *error* bks44))
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(princ))
(defun kbs03 ( / bks14)
(setq bks14 (strcase (getvar "PRODUCT")))
(if
(and
(= bks14 "AUTOCAD")
(getvar "HPDRAWORDER"))
(setq bks15 T)
(setq bks15 nil))
(if (not bks15)
(kbs13 "AUTOCAD Magazin" "\042acm-bksspeichern\042 kann nur unter AutoCAD ab Version 2005 verwendet werden." "66" "1.9"))
bks15)
(defun kbs04 (bks02 bks03 / bks13 bks11 bks12)
(if
(and
(setq bks11 (kbs11))
(setq bks12 (open bks11 "w")))
(progn
(setq bks13
(list
"alert"
":dialog{"
"key=\042t_1\042;"
":spacer{height=0.1;}"
":text{alignment=top;key=\042t_2\042;"
(strcat "width=" bks02 ";")
(strcat "height=" bks03 ";fixed_width=true;fixed_height=true;}")
":row{"
":spacer{width=5;}"
":button{label=\042OK\042;key=\042b_1\042;width=13;fixed_width=true;is_cancel=true;}"
":spacer{width=5;}}}"))
(while bks13
(write-line (car bks13) bks12)
(setq bks13 (cdr bks13)))
(setq bks12 (close bks12))
bks11)
nil))
(defun kbs05 (bks04 bks05 / bks16 bks17 bks18 bks19 bks20 bks21)
(if (setq bks16 (kbs01))
(progn
(setq bks17 (load_dialog bks16))
(if (not (new_dialog "warn" bks17))
(exit))
(vl-catch-all-apply 'vl-file-delete (list bks16))
(setq bks18 '((25 14 25 17 8) (6 33 27 33 8) (5 32 27 32 8) (3 30 26 30 2) (2 27 13 27 2) (2 26 13 26 2) (3 25 13 25 2) (3 24 13 24 2) (4 23 26 23 2) (4 22 14 22 2) (5 21 13 21 2) (5 20 13 20 2) (6 19 13 19 2) (2 29 27 29 2) (2 28 28 28 2) (4 31 27 31 -16) (3 31 3 31 54) (2 30 2 30 54) (1 26 1 29 54) (6 18 12 18 2) (6 16 6 17 54) (5 18 5 19 54) (2 24 2 25 54) (3 22 3 23 54) (4 20 4 21 54) (7 17 12 17 2) (7 16 12 16 2) (18 27 28 27 2) (18 26 27 26 2) (18 25 27 25 2) (18 24 26 24 2) (15 27 16 27 -16) (14 26 17 26 -16) (18 17 23 17 2) (18 16 22 16 2) (17 20 24 20 2) (17 19 24 19 2) (18 18 23 18 2) (16 22 25 22 2) (17 21 25 21 2) (17 17 17 17 54) (13 17 13 17 54) (14 17 16 17 -16) (13 16 17 16 -16) (16 20 16 20 54) (14 20 14 20 54) (14 19 16 19 -16) (14 18 16 18 -16) (14 25 17 25 -16) (15 24 16 24 -16) (15 22 15 20 -16) (24 16 24 17 -16) (25 18 25 19 -16) (30 24 30 33 8) (28 31 28 33 8) (29 30 29 33 8) (32 28 32 31 8) (28 30 28 30 -16) (31 26 31 32 8) (29 26 29 29 -16) (29 22 29 25 8) (28 24 28 25 -16) (27 22 27 23 -16) (28 20 28 23 8) (27 18 27 21 8) (26 20 26 21 -16) (26 16 26 19 8) (12 7 18 7 2) (12 6 17 6 2) (10 10 19 10 2) (11 9 19 9 2) (11 8 18 8 2) (11 6 11 7 54) (8 12 8 13 54) (9 10 9 11 54) (10 8 10 9 54) (8 14 12 14 2) (9 13 12 13 2) (9 12 12 12 2) (10 11 12 11 2) (8 15 12 15 2) (7 14 7 15 54) (12 4 12 5 54) (20 5 20 7 8) (18 14 21 14 2) (18 13 21 13 2) (18 12 20 12 2) (18 11 20 11 2) (18 15 22 15 2) (19 6 19 7 -16) (13 14 17 14 -16) (13 13 17 13 -16) (13 12 17 12 -16) (14 11 16 11 -16) (13 15 17 15 -16) (23 10 23 13 8) (22 8 22 11 8) (22 12 22 13 -16) (21 10 21 11 -16) (20 8 20 9 -16) (24 12 24 15 8) (23 14 23 15 -16) (21 6 21 9 8) (19 4 19 5 8) (13 5 17 5 2) (13 4 16 4 2) (14 3 15 3 2) (18 4 18 5 -16) (17 3 17 3 -16) (13 3 13 3 54) (14 2 16 2 54)))
(setq bks19 (length bks18))
(setq bks20 0)
(start_image "i_1")
(while (< bks20 bks19)
(setq bks21 (car bks18))
(setq bks18 (cdr bks18))
(vector_image (nth 0 bks21) (nth 1 bks21) (nth 2 bks21) (nth 3 bks21) (nth 4 bks21))
(setq bks20 (1+ bks20)))
(end_image)
(set_tile "t_2" (strcat bks04 "\n\nDie maximal erlaubte Zeichenzahl\nbeträgt " (nth (getvar "EXTNAMES") bks05) ". Folgende Zeichen " (nth (getvar "EXTNAMES") (list "dürfen\nverwendet werden:\n                   A - Z\n                   0 - 9\n                   $ _ -" "dürfen\nnicht verwendet werden:\n\n         < >/ \\ \042 : ; ? * | , = `"))))
(set_tile "t_1" "AUTOCAD Magazin")
(action_tile "b_1" "(done_dialog)")
(start_dialog)
(unload_dialog bks17))))
(defun kbs06 ( / bks22 bks23)
(setq bks22 (get_tile "eb_01"))
(if
(or
(= (vl-string-trim " " bks22) "")
(not (kbs07 bks22)))
(progn
(kbs05 "Ungültiger Name." (list "31" "255"))
(mode_tile "eb_01" 2)
(setq bks23 nil))
(setq bks23 bks22))
bks23)
(defun kbs07 (bks06 / bks23)
(if (= (getvar "EXTNAMES") 0)
(progn
(if
(or
(= bks06 "")
(snvalid bks06))
(setq bks23 T)
(setq bks23 nil)))
(progn
(setq bks06 (vl-string-trim " " bks06))
(if
(or
(= bks06 "")
(snvalid bks06))
(setq bks23 T)
(setq bks23 nil))))
bks23)
(defun kbs08 ( / bks16 bks17 bks15)
(if (setq bks16 (kbs10))
(progn
(setq bks17 (load_dialog bks16))
(if (not (new_dialog "acmsaveucs" bks17))
(exit))
(vl-catch-all-apply 'vl-file-delete (list bks16))
(action_tile "b_01" "(if (setq bks15 (kbs09)) (done_dialog))")
(action_tile "b_02" "(setq bks15 nil) (done_dialog)")
(start_dialog)
(unload_dialog bks17)))
bks15)
(defun kbs09 ( / bks22 bks24 bks25)
(setq bks22 (vl-string-trim " " (get_tile "eb_01")))
(if (= bks22 "")
(progn
(setq bks24 0)
(kbs13 "AUTOCAD Magazin" "Bitte Name für BKS eingeben." "23.5" "1.9")
(set_tile "eb_01" "")
(mode_tile "eb_01" 2))
(progn
(if (not (tblsearch "UCS" bks22))
(progn
(setq bks25 (kbs06))
(if bks25
(setq bks24 1)
(setq bks24 0)))
(progn
(kbs13 "AUTOCAD Magazin" "Name ist bereits vergeben." "23" "1.9")
(setq bks24 0)
(mode_tile "eb_01" 2)))))
(if (= bks24 1)
(setq bks15 bks25)
(setq bks15 nil))
bks15)
(defun kbs10 ( / bks11 bks12 bks13)
(if
(and
(setq bks11 (kbs11))
(setq bks12 (open bks11 "w")))
(progn
(setq bks13
(list
"acmsaveucs"
":dialog{label=\042Aktuelles BKS speichern\042;initial_focus=\042eb_01\042;"
":spacer{height=0.0;}"
":text{key=\042t_01\042;label=\042&Name:\042;}"
(strcat ":edit_box{key=\042eb_01\042;width=35;edit_limit=" (nth (getvar "EXTNAMES") (list "31" "255")) ";allow_accept=true;}")
":spacer{height=0.5;}"
":row{"
":spacer{width=5;}"
":column{width=0;"
":button{key=\042b_01\042;label=\042OK\042;is_default=true;}"
":button{key=\042b_02\042;label=\042Abbrechen\042;is_cancel=true;}}"
":spacer{width=5;}}}"))
(while bks13
(write-line (car bks13) bks12)
(setq bks13 (cdr bks13)))
(setq bks12 (close bks12))
bks11)
nil))
(defun kbs11 ( / bks30 bks31 bks34 bks32 bks33 bks36 bks35 kbs12)
(defun kbs12 (bks07 / bks26 bks27 bks28 bks29 p47_12)
(setq bks26 nil)
(setq bks27 0)
(setq bks28 (strcat "y_$x" (itoa bks27) ".txt"))
(while (findfile (strcat bks07 bks28))
(setq bks27 (1+ bks27))
(setq bks28 (strcat "y_$x" (itoa bks27) ".txt")))
(if (setq bks29 (open (strcat bks07 bks28) "w"))
(progn
(setq bks29 (close bks29))
(setq bks26 T))
(setq bks26 nil))
(vl-file-delete (strcat bks07 bks28))
bks26)
(setq bks30 nil)
(setq bks31 nil)
(if (setq bks32 (getenv "ACAD"))
(progn
(if (setq bks33 (vl-string-search "\073" bks32))
(setq bks34 (substr bks32 1 bks33))
(setq bks34 bks32))
(if (kbs12 (setq bks34 (strcat bks34 "\\")))
(setq bks31 bks34)
(setq bks31 nil)))
(setq bks31 nil))
(if (not bks31)
(progn
(if
(and
(setq bks30 (findfile "acad.exe"))
(setq bks34 (substr bks30 1 (- (strlen bks30) 8)))
(kbs12 bks34))
(setq bks31 bks34)
(setq bks31 nil bks30 nil bks34 nil))))
(if (not bks31)
(progn
(if
(and
(setq bks30 (findfile "acad.mnu"))
(setq bks34 (substr bks30 1 (- (strlen bks30) 8)))
(kbs12 bks34))
(setq bks31 bks34)
(setq bks31 nil bks30 nil bks34 nil))))
(if (not bks31)
(progn
(if
(and
(setq bks30 (findfile "acad.cui"))
(setq bks34 (substr bks30 1 (- (strlen bks30) 8)))
(kbs12 bks34))
(setq bks31 bks34)
(setq bks31 nil bks30 nil bks34 nil))))
(if (not bks31)
(progn
(if
(and
(setq bks30 (findfile "acad.cuix"))
(setq bks34 (substr bks30 1 (- (strlen bks30) 9)))
(kbs12 bks34))
(setq bks31 bks34)
(setq bks31 nil bks30 nil bks34 nil))))
(if (not bks31)
(progn
(if
(and
(setq bks30 (findfile "acad.mnl"))
(setq bks34 (substr bks30 1 (- (strlen bks30) 8)))
(kbs12 bks34))
(setq bks31 bks34)
(setq bks31 nil bks30 nil bks34 nil))))
(if (not bks31)
(progn
(if (kbs12 (getvar "DWGPREFIX"))
(setq bks31 (getvar "DWGPREFIX")))))
(if (not bks31)
(setq bks35 nil)
(progn
(setq bks36 0)
(while (findfile (setq bks35 (strcat bks31 (strcat "acm" (itoa bks36) ".dcl"))))
(setq bks36 (1+ bks36)))))
bks35)
(defun kbs13 (bks08 bks04 bks02 bks03 / bks16 bks17)
(if (setq bks16 (kbs04 bks02 bks03))
(progn
(setq bks17 (load_dialog bks16))
(if (not (new_dialog "alert" bks17))
(exit))
(vl-catch-all-apply 'vl-file-delete (list bks16))
(set_tile "t_2" bks04)
(set_tile "t_1" "AUTOCAD Magazin")
(action_tile "b_1" "(done_dialog)")
(start_dialog)
(unload_dialog bks17))))
(defun kbs14 ( / bks37 bks38)
(if (setq bks37 (kbs08))
(progn
(setq bks38 (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(vl-cmdf "._ucs" "_save" bks37)
(setvar "CMDECHO" bks38)
(prompt (strcat "\n*Aktuelles BKS wurde als \042" (kbs15 bks37 31) "\042 gespeichert.* ")))))
(defun kbs15 (bks09 bks10 / bks42 bks39 bks40 bks41)
(setq bks39 (strlen bks09))
(if (> bks39 bks10)
(progn
(setq bks40 (substr bks09 1 (/ (- bks10 3) 2)))
(setq bks41 (substr bks09 (- bks39 (1- (/ (- bks10 3) 2)))))
(setq bks42 (strcat bks40 "\056\056\056" bks41))))
(if bks42
bks42
bks09))
(if (kbs03)
(progn
(vl-load-com)
(sssetfirst nil nil)
(setq bks43 (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq bks44 *error*)
(setq *error* kbs02)
(vla-EndUndoMark bks43)
(vla-StartUndoMark bks43)
(kbs14)
(if bks44
(setq *error* bks44)
(setq *error* nil))
(vla-EndUndoMark bks43)))
(princ))
(terpri)
(princ (strcat "\nAutoLISP-Tool ACM-BKSSPEICHERN (Copyright © " (substr (rtos (getvar "CDATE")) 1 4) " Gerhard Rampf) geladen. "))
(princ "\nRufen Sie den Befehl mit ACM-BKSSPEICHERN auf.")
