;;  Programm:      ACM-LTYPSETZEN.LSP
;;  Befehlsaufruf: ACM-LTYPSETZEN
;;  Funktion:      Aktuellen Linientyp per Quellobjektwahl oder Auswahlliste setzen.
;;  Autor:         Gerhard Rampf
;;                 Kundenspezifische Anpassungen für AutoCAD und ZWCAD
;;                 Liebigstr. 3 A
;;                 86399 Bobingen
;;                 E-Mail: rampf@geracad.de
;;  Datum:         23.10.2025
;;  Plattform:     Alle AutoCAD-Versionen ab Version 2005
(defun c:acm-ltypsetzen ( / lts102 lts054 lts019 lts104 lts103 lst001 lst002 lst003 lst004 lst005 lst006 lst007 lst008 lst009 lst010 lst011 lst012 lst013 lst014 lst015 lst016 lst017 lst018 lst019 lst020)
(defun lst001 ( / lts013 lts014 lts016 lts015)
(setq lts013 (tblnext "LTYPE" T))
(setq lts014 (cdr (assoc 2 lts013)))
(if (not (vl-string-search "\174" lts014))
(setq lts015 (cons lts014 lts015)))
(while (setq lts016 (tblnext "LTYPE"))
(setq lts014 (cdr (assoc 2 lts016)))
(if (not (vl-string-search "\174" lts014))
(setq lts015 (cons lts014 lts015))))
lts015)
(defun lst002 ( / lts017 lts018)
(setq lts017 (strcase (getvar "PRODUCT")))
(if
(and
(= lts017 "AUTOCAD")
(getvar "HPDRAWORDER"))
(setq lts018 T)
(setq lts018 nil))
(if (not lts018)
(alert "\042acm-ltypsetzen\042 kann nur unter AutoCAD ab Version 2005 verwendet werden."))
lts018)
(defun lst003 (lts001 / )
(if lts019 (setq *error* lts019))
(if lts102 (setvar "CMDECHO" lts102))
(if lts037 (setvar "PICKBOX" lts037))
(setq lts019 nil lts102 nil lts037 nil)
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(princ))
(defun lst004 (lts002 lts003 / lts020)
(if
(and
(not (vl-position (strcase lts003) (list "VONBLOCK" "VONLAYER")))
(not (tblsearch "LTYPE" lts003)))
(setq lts020 (lst011 lts003))
(setq lts020 1))
(if (= (strcase lts003) "VONBLOCK")
(setq lts003 "byblock"))
(if (= (strcase lts003) "VONLAYER")
(setq lts003 "bylayer"))
(if (tblsearch "LTYPE" lts003)
(progn
(vl-catch-all-apply 'setvar (list "CELTYPE" lts003))
(if (= (strcase lts003) "BYBLOCK")
(setq lts003 "VonBlock"))
(if (= (strcase lts003) "BYLAYER")
(setq lts003 "VonLayer"))
(prompt (strcat "\nNeuer aktueller Linientyp: " lts003 " ")))
(prompt (strcat "\nLinientyp \042" lts003 "\042 konnte nicht aktuell gesetzt werden. "))))
(defun lst005 ( / lts023 lts021 lts022)
(if
(and
(setq lts021 (vl-filename-mktemp "acm.dcl"))
(setq lts022 (open lts021 "w")))
(progn
(setq lts023
(list
"acm_ccs"
":dialog{label=\042Einstellungen\042;"
":spacer{height=0.2;}"
":popup_list{key=\042pl_01\042;label=\042&Pickbox-Größe:\042;edit_width=8;}"
":spacer{height=0.3;}"
":toggle{key=\042tg_01\042;label=\042&Blockelemente wählbar\042;}"
":toggle{key=\042tg_02\042;label=\042&VonLayer ersetzen\042;}"
":spacer{height=0.3;}"
":row{"
":spacer{width=0;}"
":column{width=0;fixed_width=true;"
":button{key=\042b_01\042;label=\042OK\042;is_default=true;}"
":button{key=\042b_02\042;label=\042Abbrechen\042;is_cancel=true;}}"
":spacer{width=0;}}}"))
(while lts023
(write-line (car lts023) lts022)
(setq lts023 (cdr lts023)))
(setq lts022 (close lts022))
lts021)
nil))
(defun lst006 ( / lts024 lts025 lts026 lts029)
(if (setq lts024 (lst005))
(progn
(setq lts025 (load_dialog lts024))
(if (not (new_dialog "acm_ccs" lts025))
(exit))
(vl-catch-all-apply 'vl-file-delete (list lts024))
(start_list "pl_01")
(mapcar 'add_list (list (strcat "Akt. (" (itoa (getvar "PICKBOX")) ")") "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12" "13" "14" "15" "16" "17" "18" "19" "20"))
(end_list)
(set_tile "tg_01" (itoa hd2_86gb$$-dj21c))
(set_tile "tg_02" (itoa hd2_86gb$$-dj21d))
(if (= hd2_86gb$$-dj21a 0)
(set_tile "pl_01" "0")
(set_tile "pl_01" (itoa hd2_86gb$$-dj21b)))
(action_tile "b_01" "(setq lts026 (atoi (get_tile \"pl_01\")))
(if (= lts026 0)
(progn
(setq hd2_86gb$$-dj21a 0)
(setq hd2_86gb$$-dj21b (getvar \"PICKBOX\")))
(progn
(setq hd2_86gb$$-dj21a 1)
(setq hd2_86gb$$-dj21b lts026)))
(setq lts029 (list (setq hd2_86gb$$-dj21c (atoi (get_tile \"tg_01\"))) (setq hd2_86gb$$-dj21d (atoi (get_tile \"tg_02\"))) hd2_86gb$$-dj21a hd2_86gb$$-dj21b))
(done_dialog)
(lst007)")
(action_tile "b_02" "(setq lts029 nil) (done_dialog)")
(start_dialog)
(unload_dialog lts025)))
lts029)
(defun lst007 ( / )
(if (not (vl-position hd2_86gb$$-dj21a (list 0 1)))
(setq hd2_86gb$$-dj21a 0))
(if (not (vl-position hd2_86gb$$-dj21b (list 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20)))
(progn
(setq hd2_86gb$$-dj21a 0)
(setq hd2_86gb$$-dj21b (getvar "PICKBOX"))))
(if (not (vl-position hd2_86gb$$-dj21c (list 0 1)))
(setq hd2_86gb$$-dj21c 0))
(if (not (vl-position hd2_86gb$$-dj21d (list 0 1)))
(setq hd2_86gb$$-dj21d 0))
(prompt
(strcat
"\nAktuelle Einstellungen für Wahl des Linientyps: Pickbox-Größe = "
(if (= hd2_86gb$$-dj21a 0)
(strcat "Aktuelle (" (itoa (getvar "PICKBOX")) ")")
(itoa hd2_86gb$$-dj21b))
", Blockelemente wählbar = "
(nth hd2_86gb$$-dj21c (list "Nein" "Ja"))
", VonLayer ersetzen = "
(nth hd2_86gb$$-dj21d (list "Nein" "Ja")))))
(defun lst008 ( / lts036 lts033 lts034 lts035 lts037 lts038 lts039 lts040 lts041 lts042 lts043 lts044)
(if
(or
(not hd2_86gb$$-dj21e)
(and
(= (type hd2_86gb$$-dj21e) 'STR)
(vl-string-search "|" hd2_86gb$$-dj21e)))
(setq hd2_86gb$$-dj21e "VonLayer"))
(if (/= (strcase hd2_86gb$$-dj21e) "VONLAYER")
(progn
(setq lts033 "Vonlayer Auswahlliste Einstellungen")
(setq lts034 (strcat "\nAktuell zu setzenden Linientyp durch Objekt wählen oder [Vonlayer/Auswahlliste/Einstellungen] <" hd2_86gb$$-dj21e ">: ")))
(progn
(setq lts033 "Auswahlliste Einstellungen")
(setq lts034 "\nAktuell zu setzenden Linientyp durch Objekt wählen oder [Auswahlliste/Einstellungen] <VonLayer>: ")))
(setq lts035 (getvar "ERRNO"))
(setvar "ERRNO" 7)
(while (= (getvar "ERRNO") 7)
(setvar "ERRNO" 0)
(if (= hd2_86gb$$-dj21c 0)
(setq lts036 entsel)
(setq lts036 nentsel))
(setq lts037 (getvar "PICKBOX"))
(setvar "PICKBOX" hd2_86gb$$-dj21b)
(initget lts033)
(setq lts038 (lts036 lts034))
(setvar "PICKBOX" lts037)
(if (not lts038)
(setq lts039 hd2_86gb$$-dj21e)
(progn
(if (= (type lts038) 'STR)
(progn
(if (= lts038 "Vonlayer")
(setq lts039 "Vonlayer"))
(if (= lts038 "Auswahlliste")
(progn
(if (not (setq lts039 (lst010)))
(setvar "ERRNO" 7))))
(if (= lts038 "Einstellungen")
(progn
(lst006)
(setvar "ERRNO" 7)
(setq lts040 T))))
(progn
(setq lts041 (car lts038))
(setq lts042 (entget lts041))
(setq lts039 (cdr (assoc 6 lts042)))
(if (not lts039)
(progn
(if (= hd2_86gb$$-dj21d 0)
(setq lts039 "VonLayer")
(progn
(setq lts043 (tblobjname "LAYER" (cdr (assoc 8 lts042))))
(setq lts044 (entget lts043))
(setq lts039 (cdr (assoc 6 lts044)))))))))))
(if
(and
(= (getvar "ERRNO") 7)
(not lts040))
(prompt "0 gefunden"))
(setq lts040 nil))
(if lts035
(setvar "ERRNO" lts035))
(if lts039
(setq hd2_86gb$$-dj21e lts039)
nil))
(defun lst009 ( / lts023 lts021 lts022)
(if
(and
(setq lts021 (vl-filename-mktemp "acm.dcl"))
(setq lts022 (open lts021 "w")))
(progn
(setq lts023
(list
"acm_clt"
":dialog{label=\042Linientyp wählen\042;initial_focus=\042lb_01\042;"
":spacer{height=0.2;}"
":list_box{key=\042lb_01\042;width=35;height=12;allow_accept=true;}"
":spacer{height=0.3;}"
":row{"
":spacer{width=1;}"
":column{width=0;fixed_width=true;"
":button{key=\042b_01\042;label=\042OK\042;is_default=true;}"
":button{key=\042b_02\042;label=\042Abbrechen\042;is_cancel=true;}}"
":spacer{width=1;}}}"))
(while lts023
(write-line (car lts023) lts022)
(setq lts023 (cdr lts023)))
(setq lts022 (close lts022))
lts021)
nil))
(defun lst010 ( / lts024 lts025 lts045 lts046 lts047 lts048 lts049 lts050 lts051 lts052 lts029)
(if (setq lts024 (lst009))
(progn
(setq lts025 (load_dialog lts024))
(if (not (new_dialog "acm_clt" lts025))
(exit))
(vl-catch-all-apply 'vl-file-delete (list lts024))
(if (/= (type hd2_86gb$$-dj21e) 'STR)
(setq hd2_86gb$$-dj21e "VonLayer"))
(setq lts045 (lst018 (getvar "MEASUREMENT")))
(setq lts046 (car lts045))
(setq lts047 (mapcar 'strcase lts046))
(setq lts048 (lst001))
(while lts048
(if (not (vl-position (strcase (setq lts049 (car lts048))) lts047))
(setq lts046 (cons lts049 lts046)))
(setq lts048 (cdr lts048)))
(setq lts050 (append (list "VonLayer" "VonBlock") (acad_strlsort lts046)))
(setq lts051 (mapcar 'strcase lts050))
(if (not (setq lts052 (vl-position (strcase hd2_86gb$$-dj21e) lts051)))
(setq lts052 0))
(start_list "lb_01")
(mapcar 'add_list lts050)
(end_list)
(set_tile "lb_01" (itoa lts052))
(action_tile "b_01" "(setq lts029 (nth (atoi (get_tile \"lb_01\")) lts050)) (setq hd2_86gb$$-dj21e lts029) (done_dialog)")
(action_tile "b_02" "(setq lts029 nil) (done_dialog)")
(start_dialog)
(unload_dialog lts025)))
lts029)
(defun lst011 (lts004 / lts053 lts054 lts055 lts056 lts057 lts058 lts059 lts060 lts061 lts062 lts063 lts064 lts065)
(if
(and
(= (type lts004) 'STR)
(snvalid lts004)
(not (tblsearch "LTYPE" lts004)))
(progn
(setq lts053 (vlax-get-acad-object))
(setq lts054 (vla-get-ActiveDocument lts053))
(setq lts055 (vla-get-Linetypes lts054))
(if
(and
(not (vl-catch-all-error-p (setq lts056 (vl-catch-all-apply 'vla-get-Preferences (list lts053)))))
(not (vl-catch-all-error-p (setq lts057 (vl-catch-all-apply 'vla-get-Files (list lts056)))))
(not (vl-catch-all-error-p (setq lts058 (vl-catch-all-apply 'vla-get-SupportPath (list lts057))))))
(setq lts059 (lst019 lts058 ";" 1))
(progn
(if (setq lts060 (getenv "ACAD"))
(setq lts059 (lst019 lts060 ";" 1)))
(if
(and
(not lts059)
(setq lts060 (getenv "ZWCAD")))
(setq lts059 (lst019 lts060 ";" 1)))))
(while lts059
(setq lts061 (append lts061 (vl-directory-files (car lts059) "*.lin" 1)))
(setq lts059 (cdr lts059)))
(while lts061
(if (vl-string-search "iso.lin" (setq lts062 (car lts061)))
(setq lts063 (append lts063 (list lts062)))
(setq lts064 (append lts064 (list lts062))))
(setq lts061 (cdr lts061)))
(if (< (getvar "MEASUREINIT") 1)
(setq lts065 (append lts064 lts063))
(setq lts065 (append lts063 lts064)))
(while
(and
(not (tblsearch "LTYPE" lts004))
lts065)
(vl-catch-all-apply 'vla-Load (list lts055 lts004 (car lts065)))
(setq lts065 (cdr lts065)))
(tblsearch "LTYPE" lts004)))
(if (= (type lts004) 'STR)
(tblsearch "LTYPE" lts004)
nil))
(defun lst012 (lts005 / lts066)
(if (setq lts066 (findfile "ltypeshp.shx"))
(progn
(if (= (type (vl-catch-all-apply 'vla-LoadShapeFile (list lts005 lts066))) 'VL-CATCH-ALL-APPLY-ERROR)
(prompt (strcat "Kann Symboldatei \042ltypeshp.shx\042 in \042" (lst013 lts005) "\042 nicht laden. "))
(setq lts029 T)))
(setq lts029 nil)))
(defun lst013 (lts005 / lts067 lts068)
(setq lts067 (vl-string-right-trim "\\" (vla-get-Path lts005)))
(setq lts068 (vla-get-Name lts005))
(strcat lts067 "\\" lts068))
(defun lst014 (lts006 lts007 / lts069 lts070 lts071 lts072)
(setq lts006 (mapcar 'strcase lts006))
(while lts006
(setq lts069 (car lts006))
(if (vl-string-search "ISO" lts069)
(setq lts070 (cons lts069 lts070))
(setq lts071 (cons lts069 lts071)))
(setq lts006 (cdr lts006)))
(if (= lts007 0)
(setq lts072 (append lts071 lts070))
(setq lts072 (append lts070 lts071)))
lts072)
(defun lst015 ( / lts017 lts073 lts060 lts074)
(if
(and
(setq lts017 (getvar "PRODUCT"))
(= (type lts017) 'STR)
(vl-position (setq lts073 (strcase lts017)) '("AUTOCAD" "BRICSCAD" "ZWCAD")))
(progn
(if (= lts073 "AUTOCAD")
(setq lts060 "ACAD"))
(if (= lts073 "BRICSCAD")
(setq lts060 "BRICSCAD"))
(if (= lts073 "ZWCAD")
(setq lts060 "ZWCAD")))
(setq lts060 "ACAD"))
(setq lts074 (getenv lts060))
(lst019 lts074 ";" 1))
(defun lst016 (lts008 / lts076 lts077 lts078 lts079 lts039 lts080)
(if
(and
(setq lts075 (findfile lts008))
(setq lts076 (lst020 lts075)))
(progn
(while lts076
(if (= (substr (setq lts077 (car lts076)) 1 1) "*")
(progn
(setq lts077 (substr lts077 2))
(if
(and
(setq lts078 (car (lst019 lts077 "," 0)))
(snvalid lts078))
(progn
(setq lts079 (strcase lts078))
(if (not (vl-position lts079 lts080))
(setq lts039 (cons lts078 lts039)))
(setq lts080 (cons (setq lts079 (strcase lts078)) lts080))))))
(setq lts076 (cdr lts076)))
(if lts039
(list lts039 lts075)
nil))
nil))
(defun lst017 (lts009 / lts081 lts082 lts083 lts084 lts085)
(setq lts081 (lst015))
(while lts081
(setq lts082 (car lts081))
(if (setq lts083 (vl-directory-files lts082 "*.lin" 1))
(progn
(setq lts084 (lst014 lts083 lts009))
(setq lts085 (cons (list lts082 lts084) lts085))))
(setq lts081 (cdr lts081)))
lts085)
(defun lst018 (lts009 / lts061 lts086 lts087 lts088 lts089 lts090 lts091 lts092 lts093 lts094 lts095 lts096)
(setq lts061 (lst017 lts009))
(while lts061
(setq lts086 (car lts061))
(setq lts087 (vl-string-right-trim "\\" (car lts086)))
(setq lts088 (cadr lts086))
(while lts088
(setq lts089 (car lts088))
(setq lts090 (strcat lts087 "\\" lts089))
(if (setq lts091 (lst016 lts090))
(progn
(setq lts092 (car lts091))
(while lts092
(setq lts093 (car lts092))
(setq lts094 (strcase lts093))
(if (not (vl-position lts094 lts095))
(progn
(setq lts095 (cons (strcase lts093) lts095))
(setq lts096 (cons (cons lts093 lts090) lts096))))
(setq lts092 (cdr lts092)))))
(setq lts088 (cdr lts088)))
(setq lts061 (cdr lts061)))
(if lts096
(list (acad_strlsort (mapcar 'car lts096)) lts096)
nil))
(defun lst019 (lts010 lts011 lts007 / lts097 lts098)
(setq lts010 (vl-string-trim lts011 lts010))
(if (> lts007 0)
(setq lts010 (vl-string-trim " " lts010)))
(while (setq lts097 (vl-string-search lts011 lts010))
(setq lts098 (append lts098 (list (substr lts010 1 lts097))))
(setq lts010 (vl-string-left-trim lts011 (substr lts010 (1+ lts097)))))
(append lts098 (list lts010)))
(defun lst020 (lts012 / lts099 lts100 lts101 lts039)
(setq lts099 (findfile lts012))
(if (not lts099)
(progn
(repeat 20
(setq lts099 (findfile lts012)))))
(if lts099
(progn
(setq lts100 (open lts099 "r"))
(while (setq lts101 (read-line lts100))
(setq lts039 (append lts039 (list lts101))))
(if lts100
(setq lts100 (close lts100)))
lts039)))
(if (lst002)
(progn
(vl-load-com)
(setq lts102 (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq lts054 (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq lts019 *error*)
(setq *error* lst003)
(vla-EndUndoMark lts054)
(vla-StartUndoMark lts054)
(lst007)
(if
(and
(setq lts103 (lst008))
(not (vl-string-search "|" lts103)))
(progn
(vl-catch-all-apply 'lst012 (list lts054))
(lst004 lts104 lts103))
(progn
(if lts103
(alert "XRef-abhängige Linientypen können nicht aktuell gesetzt werden."))))
(if lts019
(setq *error* lts019)
(setq *error* nil))
(setvar "CMDECHO" lts102)
(vla-EndUndoMark lts054)))
(princ))
(terpri)
(princ (strcat "\nAutoLISP-Tool ACM-LTYPSETZEN (Copyright © " (substr (rtos (getvar "CDATE")) 1 4) " Gerhard Rampf) geladen. "))
(princ "\nRufen Sie den Befehl mit ACM-LTYPSETZEN auf. ")
