;;;   Programm:      ACM-OBJEKTHOEHEAENDERN.LSP
;;;   Befehlsaufruf: ACM-OBJEKTHOEHEAENDERN
;;;   Funktion:      Objekthöhe ändern
;;;   Autor:         Gerhard Rampf
;;;                  Kundenspezifische Anpassungen für AutoCAD und ZWCAD
;;;                  Liebigstr. 3 A
;;;                  86399 Bobingen
;;;                  E-Mail: rampf@geracad.de
;;;   Datum:         08.02.2025
;;;   Plattform:     Alle AutoCAD-Versionen ab Version 2005
(defun c:acm-objekthoeheaendern ( / mdd16 mdd50 dmd01 dmd02 dmd03 dmd04 dmd05 dmd06 dmd07 dmd08 dmd09 dmd10 dmd12 dmd13)
    (defun dmd01 (mdd01 / mdd09 mdd10)
      (setq mdd09 (getvar "LUPREC"))
      (setq mdd10 (getvar "DIMZIN"))
      (setvar "LUPREC" 8)
      (setvar "DIMZIN" 8)
      (setq mdd11 (rtos mdd01))
      (setvar "DIMZIN" mdd10)
      (setvar "LUPREC" mdd09)
      mdd11
    )
    (defun dmd02 (mdd02 / )
      (if mdd47 (vl-catch-all-apply 'setvar (list "CMDECHO" mdd47)))
      (if mdd09 (vl-catch-all-apply 'setvar (list "LUPREC" mdd09)))
      (if mdd10 (vl-catch-all-apply 'setvar (list "DIMZIN" mdd10)))
      (if mdd50 (setq *error* mdd50))
      (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
      (princ)
    )
    (defun dmd03 ( / mdd12)
      (setq mdd12 (strcase (getvar "PRODUCT")))
        (if
          (and
            (= mdd12 "AUTOCAD")
            (getvar "HPDRAWORDER")
          )
            (setq mdd13 T)
            (setq mdd13 nil)
        )
        (if (not mdd13)
          (alert "\042acm-objekthoeheaendern\042 kann nur unter AutoCAD ab Version 2005 verwendet werden.")
        )
      mdd13
    )
    (defun dmd04 (mdd03 / mdd14)
      (while mdd03
        (setq mdd14 (car mdd03))
        (vla-put-Lock mdd14 :vlax-true)
        (setq mdd03 (cdr mdd03))
      )
    )
    (defun dmd05 ( / mdd15 mdd16 mdd17 V-Lay mdd18)
      (setq mdd15 (vlax-get-acad-object))
      (setq mdd16 (vla-get-ActiveDocument mdd15))
      (setq mdd17 (vla-get-Layers mdd16))
        (vlax-for V-Lay mdd17
          (if (= (vla-get-Lock V-Lay) :vlax-true)
            (setq mdd18 (cons V-Lay mdd18))
          )
        )
      mdd18
    )
    (defun dmd06 ( / mdd19)
      (if (= $value "1")
        (progn
            (if (setq mdd19 (distof (get_tile "eb_01")))
              (setq skeu381_k--l8ehatrrs2 mdd19)
            )
          (mode_tile "eb_01" 1)
          (set_tile "eb_01" (dmd01 (getvar "THICKNESS")))
        )
        (progn
          (mode_tile "eb_01" 0)
          (set_tile "eb_01" (dmd01 skeu381_k--l8ehatrrs2))
          (mode_tile "eb_01" 2)
        )
      )
    )
    (defun dmd07 ( / mdd13)
        (if (= $reason 1)
          (setq mdd13 (dmd09))
        )
      mdd13
    )
    (defun dmd08 ( / mdd23 mdd21 mdd22)
      (if
        (and
          (setq mdd21 (vl-filename-mktemp "acm.dcl"))
          (setq mdd22 (open mdd21 "w"))
        )
          (progn
            (setq mdd23
              (list
                "thickness"
                ":dialog{"
                "label=\042Objekthöhe ändern\042;"
                "initial_focus=\042eb_01\042;"
                ":spacer{"
                "height=0.2;"
                "}"
                ":row{"
                ":column{"
                ":spacer{"
                "height=0;"
                "}"
                ":text{"
                "label=\042Obj&ekthöhe:\042;"
                "}"
                ":text{"
                "value=\042\042;"
                "}"
                "}"
                ":column{"
                ":edit_box{"
                "key=\042eb_01\042;"
                "}"
                ":toggle{"
                "key=\042tg_01\042;"
                "label=\042&Aktuelle verwenden\042;"
                "}"
                "}"
                "}"
                ":spacer{"
                "height=0.3;"
                "}"
                ":toggle{"
                "key=\042tg_02\042;"
                "label=\042Layer&sperrungen ignorieren\042;"
                "}"
                ":spacer{"
                "height=0.3;"
                "}"
                ":row{"
                ":spacer{"
                "width=2;"
                "}"
                ":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=2;"
                "}"
                "}"
                "}"
              )
            )
            (while mdd23
              (write-line (car mdd23) mdd22)
              (setq mdd23 (cdr mdd23))
            )
            (setq mdd22 (close mdd22))
            mdd21
          )
          nil
      )
    )
    (defun dmd09 ( / mdd19 mdd24 mdd13)
      (setq mdd19 (get_tile "eb_01"))
        (if
          (and
            (= (get_tile "tg_01") "0")
            (not (setq mdd24 (distof mdd19)))
          )
            (progn
              (alert "Ungültige Eingabe für Objekthöhe.")
              (mode_tile "eb_01" 2)
              (setq mdd13 nil)
            )
            (progn
                (setq mdd13
                  (list 
                    (setq skeu381_k--l8ehatrrs2 (distof (get_tile "eb_01"))) 
                    (setq skeu381_k--l8ehbtrrs2 (get_tile "tg_01"))
                    (setq skeu381_k--l8ehctrrs2 (get_tile "tg_02"))
                  )
                )
              (done_dialog)
            )
        )
      mdd13
    )
    (defun dmd10 (mdd04 mdd05 mdd06 / mdd27 mdd28 mdd29 mdd30 mdd31 mdd32 mdd33 mdd34 mdd35 mdd36 mdd13)
      (prompt (strcat "\nMit Objekthöhe " (rtos mdd06) " auszustattende Objekte wählen ... "))
        (if (= mdd04 1)
          (setq mdd27 (ssget))
          (setq mdd27 (ssget "_:L"))
        )
        (if mdd27
          (progn
            (setq mdd28 (sslength mdd27))
            (setq mdd29 -1)
            (setq mdd30 (ssadd))
              (repeat mdd28
                (setq mdd29 (1+ mdd29))
                (setq mdd31 (ssname mdd27 mdd29))
                (setq mdd32 (vlax-ename->vla-object mdd31))
                (setq mdd33 (vl-catch-all-apply 'vlax-get (list mdd32 'Thickness)))
                (setq mdd34 (type mdd33))
                  (if (/= mdd34 'VL-CATCH-ALL-APPLY-ERROR)
                    (progn
                      (ssadd mdd31 mdd30)
                      (setq mdd35 (cons mdd32 mdd35))
                    )
                  )
              )
            (setq mdd36 (length mdd35))
              (if (> mdd36 0)
                (progn
                  (if (= mdd05 0)
                    (setq mdd13 mdd30)
                    (setq mdd13 mdd35)
                  )
                )
                (setq mdd13 nil)
              )
          )
          (setq mdd13 nil)
        )
      mdd13
    )
    (defun dmd11 (mdd07 mdd08 / mdd37 mdd38 mdd39 mdd40)
      (setq mdd37 (length mdd08))
        (if (setq mdd38 (member mdd07 mdd08))
          (progn
            (setq mdd39 (length mdd38))
            (setq mdd40 (- mdd37 mdd39))
          )
          (setq mdd40 nil)
        )
      mdd40
    )
    (defun dmd12 ( / mdd41 mdd42 mdd43 mdd13)
        (if (setq mdd41 (dmd08))
          (progn
            (setq mdd42 (load_dialog mdd41))
              (if (not (new_dialog "thickness" mdd42))
                (exit)
              )
            (vl-catch-all-apply 'vl-file-delete (list mdd41))
              (if (not (dmd11 (type skeu381_k--l8ehatrrs2) (list 'INT 'REAL)))
                (setq skeu381_k--l8ehatrrs2 0.0)
              )
              (if (not (dmd11 skeu381_k--l8ehbtrrs2 (list "0" "1")))
                (setq skeu381_k--l8ehbtrrs2 "0")
              )
              (if (not (dmd11 skeu381_k--l8ehctrrs2 (list "0" "1")))
                (setq skeu381_k--l8ehctrrs2 "0")
              )
            (setq mdd43 skeu381_k--l8ehatrrs2)
            (set_tile "eb_01" (dmd01 skeu381_k--l8ehatrrs2))
            (set_tile "tg_01" skeu381_k--l8ehbtrrs2)
            (set_tile "tg_02" skeu381_k--l8ehctrrs2)
              (if (= (get_tile "tg_01") "1")
                (progn
                  (mode_tile "eb_01" 1)
                  (set_tile "eb_01" (rtos (getvar "THICKNESS")))
                )
              )
            (action_tile "tg_01" "(dmd06)")
            (action_tile "eb_01" "(setq mdd13 (dmd07))")
            (action_tile "b_01" "(setq mdd13 (dmd09))")
            (action_tile "b_02" "(setq skeu381_k--l8ehatrrs2 mdd43) (setq mdd13 nil) (done_dialog)")
            (start_dialog)
            (unload_dialog mdd42)
          )
        )
      mdd13
    )
    (defun dmd13 ( / mdd44 mdd45 mdd46 mdd47 mdd48 mdd49)
      (if
        (and
          (setq mdd44 (dmd12))
          (setq mdd45 (dmd10 (atoi (nth 2 mdd44)) 0 (setq mdd46 (nth 0 mdd44))))
        )
          (progn
            (setq mdd47 (getvar "CMDECHO"))
            (setvar "CMDECHO" 0)
              (if
                (and
                  (= (nth 2 mdd44) "1")
                  (setq mdd48 (dmd05))
                )
                  (progn
                    (setq mdd49 1)
                    (vl-cmdf "._-layer" "_unlock" "*" "")
                  )
                  (setq mdd49 0)
              )
            (vl-cmdf "._chprop" mdd45 "" "_thickness" mdd46 "")
              (if
                (and
                  (= mdd49 1)
                  mdd48
                )
                  (dmd04 mdd48)
              )
            (setvar "CMDECHO" mdd47)
         )
      )
    )
  (if (dmd03)
    (progn
      (vl-load-com)
      (sssetfirst nil nil)
      (setq mdd16 (vla-get-ActiveDocument (vlax-get-acad-object)))
      (setq mdd50 *error*)
      (setq *error* dmd02)
      (vla-EndUndoMark mdd16)
      (vla-StartUndoMark mdd16)
      (dmd13)
        (if mdd50
          (setq *error* mdd50)
          (setq *error* nil)
        )
      (vla-EndUndoMark mdd16)
    )
  )
  (princ)
)
(terpri)
(princ (strcat "\nAutoLISP-Tool ACM-OBJEKTHOEHEAENDERN (Copyright © " (substr (rtos (getvar "CDATE")) 1 4) " Gerhard Rampf) geladen. "))
(princ "\nRufen Sie den Befehl mit ACM-OBJEKTHOEHEAENDERN auf.")
