;;;   Programm:      ACM-MOFFSET.LSP
;;;   Befehlsaufruf: ACM-MOFFSET
;;;   Funktion:      Mehrere Objekte gleichzeitig versetzen
;;;   Autor:         Gerhard Rampf
;;;                  Kundenspezifische Anpassungen für AutoCAD und ZWCAD
;;;                  Liebigstr. 3 A
;;;                  86399 Bobingen
;;;                  E-Mail: rampf@geracad.de
;;;   Datum:         24.10.2023
;;;   Plattform:     Alle AutoCAD-Versionen ab Version 2005
(defun c:acm-moffset ( / mof70 mof71 mfo01 mfo02 mfo03 mfo04 mfo05 mfo06 mfo07 mfo08 mfo09 mfo10 mfo11 mfo12 mfo13 mfo14 mfo15 mfo16 mfo17 mfo18 mfo19 mfo20)
    (defun mfo01 ( / mof16 mof72 mof17)
      (setq mof16 (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))))
        (vlax-for mof72 mof16
          (if (= (vla-get-Lock mof72) :vlax-true)
            (setq mof17 (cons (strcase (vla-get-Name mof72)) mof17))
          )
        )
      mof17
    )
    (defun mfo02 ( / mof18 mof19 mof20 mof21 mof22 mof23 mof24 mof26 mof27)
        (if (setq mof18 (ssget "_i" (list (cons 0 "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,RAY,SPLINE,XLINE"))))
          (progn
            (setq mof19 (mfo01))
            (setq mof20 (sslength mof18))
            (setq mof21 -1)
            (setq mof22 0)
              (repeat mof20
                (setq mof23 nil)
                (setq mof21 (1+ mof21))
                (setq mof24 (ssname mof18 mof21))
                  (if
                    (and
                      (vl-position (strcase (vla-get-ObjectName (setq mof25 (vlax-ename->vla-object mof24)))) (list "ACDB2DPOLYLINE" "ACDBARC" "ACDBCIRCLE" "ACDBELLIPSE" "ACDBLINE" "ACDBPOLYLINE" "ACDBRAY" "ACDBSPLINE" "ACDBXLINE"))
                      (not (setq mof23 (vl-position (strcase (vla-get-Layer mof25)) mof19)))
                    )
                      (setq mof26 (cons mof24 mof26))
                      (progn
                        (if mof23
                          (setq mof22 (1+ mof22))
                        )
                      )
                  )
              )
          )
        )
        (if
          (and
            mof18
            (not mof26)
            (> mof22 0)
          )
            (prompt (strcat "\n" (if (= mof22 1) "Gewähltes Objekt war auf einem gesperrten Layer. " (strcat "Alle (" (itoa mof22) ") waren auf einem gesperrten Layer. "))))
        )
        (if
          (and
            mof18
            mof26
           (> mof22 1)
          )
            (prompt (strcat "\n" (itoa (setq mof27 (length mof26))) (if (= mof27 1) " versetzbares Objekt" " versetzbare Objekte") " gewählt. " (if (= mof22 1) "1 war auf einem gesperrten Layer. " (strcat (itoa mof22) " waren auf einem gesperrten Layer. "))))
        )
        (if
          (and
            (ssget "_i")
            (not mof18)
          )
            (prompt "\nKeine versetzbaren Objekte gewählt. Gültig sind: 2D-Polylinie, Bogen, Ellipse, Konstruktionslinie, Kreis, Linie, Polylinie, Spline und Strahl ")
        )
      (sssetfirst nil nil)
      mof26
    )
    (defun mfo03 (mof01 / )
        (if mof71 (setq *error* mof71))
        (if mof35
          (vl-catch-all-apply 'setvar (list "CMDECHO" mof35))
        )
        (if mof37
          (vl-catch-all-apply 'setvar (list "OFFSETDIST" mof37))
        )
        (if mof58
          (vl-catch-all-apply 'setvar (list "DIMZIN" mof58))
        )
        (if mof36
          (vl-catch-all-apply 'setvar (list "OSMODE" mof36))
        )
      (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
      (princ)
    )
    (defun mfo04 (mof02 / mof28 mof29 mof30 mof31 mof32)
        (while (setq mof28 (entnext mof02))
          (setq mof29 (cons mof28 mof29))
          (setq mof02 mof28)
        )
        (while mof29
            (if
              (and
                (not (vl-string-search "SEQ" (setq mof30 (strcase (vla-get-ObjectName (vlax-ename->vla-object (setq mof31 (car mof29))))))))
                (not (vl-string-search "VERT" mof30))
              )
                (setq mof32 (cons mof31 mof32))
            )
          (setq mof29 (cdr mof29))
        )
      mof32
    )
    (defun mfo05 ( / mof18 mof33 mof34 mof21 mof35 mof36 mof37)
      (if (setq mof18 (mfo02))
        (progn
          (if (setq mof33 (mfo13))
            (progn
              (setq mof34 (mfo06 (mfo20 mof18)))
            )
          )
        )
        (progn
          (if (setq mof33 (mfo13))
            (progn
              (if (setq mof18 (mfo12))
                (setq mof34 (mfo06 (mfo20 mof18)))
              )
            )
          )
        )
      )
      (if
        (and
          mof18
          mof33
          mof34
        )
          (progn
            (setq mof21 -1)
            (setq mof35 (getvar "CMDECHO"))
            (setq mof36 (getvar "OSMODE"))
            (setq mof37 (getvar "OFFSETDIST"))
            (setvar "CMDECHO" 0)
            (setvar "OSMODE" 0)
              (repeat (length mof18)
                (mfo19 mof33 (nth (setq mof21 (1+ mof21)) mof18) mof34)
              )
            (setvar "OFFSETDIST" mof37)
            (setvar "OSMODE" mof36)
            (setvar "CMDECHO" mof35)
          )
      )
    )
    (defun mfo06 (mof03 / mof38 mof39)
      (setq mof38 "Layer")
        (while (= mof38 "Layer")
          (initget "Layer")
          (setq mof38 (getpoint "\nPunkt auf Seite angeben, auf die versetzt werden soll oder [Layer]: "))
            (if (= mof38 "Layer")
              (setq mof39 (mfo08 mof03))
            )
        )
        (if mof39
          (list mof38 mof39)
          (list mof38)
        )
    )
    (defun mfo07 ( / mof16 mof73 mof17)
      (setq mof16 (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))))
        (vlax-for mof73 mof16
          (if (not (vl-string-search "|" (setq mof40 (vlax-get mof73 'Name))))
            (setq mof17 (cons mof40 mof17))
          )
        )
      (acad_strlsort mof17)
    )
    (defun mfo08 (mof03 / mof41 mof42 mof43 mof44 mof46 mof47)
        (if (setq mof41 (mfo09))
          (progn
            (setq mof42 (load_dialog mof41))
              (if (not (new_dialog "moffset" mof42))
                (exit)
              )
            (vl-catch-all-apply 'vl-file-delete (list mof41))
            (setq mof43 (mfo07))
            (setq mof44 (mapcar 'strcase mof43))
              (if
                (or
                  (/= (type acm202308moffset11739) 'STR)
                  (and
                    (= (type acm202308moffset11739) 'STR)
                    (not (tblsearch "LAYER" acm202308moffset11739))
                  )
                )
                  (setq acm202308moffset11739 (car mof44))
              )
            (setq acm202308moffset11739 (strcase acm202308moffset11739))
            (start_list "lb_01")
            (mapcar 'add_list mof43)
            (end_list)
            (setq mof46 (vl-position acm202308moffset11739 mof44))
            (set_tile "lb_01" (itoa mof46))
            (action_tile "b_01" "(prompt (strcat \"\nLayer der versetzten Objekte = \" (mfo11 (nth (atoi (get_tile \"lb_01\")) mof43) 39) \" \")) (setq mof47 (list 1 (setq acm202308moffset11739 (nth (atoi (get_tile \"lb_01\")) mof44)))) (done_dialog)")
            (action_tile "b_02" "(prompt (strcat \"\nLayer der versetzten Objekte = Von Quelle (\" (mfo11 mof03 39) \") \")) (setq mof47 (list 0)) (done_dialog)")
            (start_dialog)
            (unload_dialog mof42)
          )
        )
      mof47
    )
    (defun mfo09 ( / mof48 mof49 mof50)
      (if
        (and
          (setq mof48 (vl-filename-mktemp "acm.dcl"))
          (setq mof49 (open mof48 "w"))
        )
          (progn
            (setq mof50
              (list
                "moffset"
                ":dialog{label=\042Layer wählen\042;"
                ":spacer{height=0;}"
                ":list_box{key=\042lb_01\042;height=10;allow_accept=true;}"
                ":spacer{height=0.3;}"
                ":row{"
                ":spacer{width=8;}"
                ":column{width=0;"
                ":button{key=\042b_01\042;label=\042Verwenden\042;is_default=true;}"
                ":button{key=\042b_02\042;label=\042Von Quelle\042;is_cancel=true;}}"
                ":spacer{width=8;}}}"
              )
            )
              (while mof50
                (write-line (car mof50) mof49)
                (setq mof50 (cdr mof50))
              )
            (setq mof49 (close mof49))
            mof48
          )
          nil
      )
    )
    (defun mfo10 ( / mof51)
      (setq mof51 (strcase (getvar "PRODUCT")))
        (if
          (and
            (= mof51 "AUTOCAD")
            (getvar "HPDRAWORDER")
          )
            (setq mof47 T)
            (setq mof47 nil)
        )
        (if (not mof47)
          (alert "\042acm-moffset\042 kann nur unter AutoCAD ab Version 2005 verwendet werden.")
        )
      mof47
    )
    (defun mfo11 (mof04 mof05 / mof55 mof52 mof53 mof54)
      (setq mof52 (strlen mof04))
        (if (> mof52 mof05)
          (progn
            (setq mof53 (substr mof04 1 (/ (- mof05 3) 2)))
            (setq mof54 (substr mof04 (- mof52 (1- (/ (- mof05 3) 2)))))
            (setq mof55 (strcat mof53 "\056\056\056" mof54))
          )
        )
        (if mof55
          mof55
          mof04
        )
    )
    (defun mfo12 ( / mof18 mof20 mof21 mof24 mof26 mof27)
        (if (setq mof18 (ssget "_:L" (list (cons 0 "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,RAY,SPLINE,XLINE"))))
          (progn
            (setq mof20 (sslength mof18))
            (setq mof21 -1)
              (repeat mof20
                (setq mof21 (1+ mof21))
                (setq mof24 (ssname mof18 mof21))
                  (if (vl-position (strcase (vla-get-ObjectName (vlax-ename->vla-object mof24))) (list "ACDB2DPOLYLINE" "ACDBARC" "ACDBCIRCLE" "ACDBELLIPSE" "ACDBLINE" "ACDBPOLYLINE" "ACDBRAY" "ACDBSPLINE" "ACDBXLINE"))
                    (setq mof26 (cons mof24 mof26))
                  )
              )
          )
        )
        (if mof26
          (prompt (strcat "\n" (mfo18 (setq mof27 (length mof26))) (if (= mof27 1) " versetzbares Objekt" " versetzbare Objekte") " gewählt. "))
          (prompt "\nKeine versetzbaren Objekte gewählt. Gültig sind: 2D-Polylinie, Bogen, Ellipse, Konstruktionslinie, Kreis, Linie, Polylinie, Spline und Strahl ")
        )
      mof26
    )
    (defun mfo13 ( / mof57)
        (if
          (not
            (and
              (vl-position (type acm202308moffset21739) (list 'INT 'REAL))
              (> acm202308moffset21739 0)
            )
          )
            (setq acm202308moffset21739 1.0)
        )
      (initget 6)
        (if (not (setq mof57 (getdist (strcat "\nAbstand angeben <" (mfo14 (rtos acm202308moffset21739 2)) ">: "))))
          (setq mof57 acm202308moffset21739)
          (setq acm202308moffset21739 mof57)
        )
      mof57
    )
    (defun mfo14 (mof06 / mof58 mof59)
        (if (= (type mof06) 'STR)
          (progn
            (if (distof mof06)
              (progn
                (setq mof58 (getvar "DIMZIN"))
                (mfo17 "DIMZIN" 8)
                (setq mof06 (rtos (distof mof06) 2 8))
                (setq mof59 (rtos (distof mof06 2) (getvar "LUNITS") (mfo15 mof06)))
                  (if mof58
                    (mfo17 "DIMZIN" mof58)
                  )
                mof59
              )
              nil
            )
          )
          nil
        )
    )
    (defun mfo15 (mof06 / mof52 mof58 mof60)
      (setq mof52 nil)
        (if (= (type mof06) 'STR)
          (progn
            (setq mof58 (getvar "DIMZIN"))
            (mfo17 "DIMZIN" 8)
            (setq mof06 (rtos (distof mof06) 2 8))
              (if mof58
                (mfo17 "DIMZIN" mof58)
              )
            (setq mof60 (mfo16 mof06 "\056"))
              (if mof60
                (setq mof52 (- (strlen mof06) mof60))
                (setq mof52 0)
              )
              (if (> mof52 8)
                (setq mof52 8)
              )
          )
        )
      mof52
    )
    (defun mfo16 (mof07 mof08 / mof52 mof61 mof62 mof63)
        (if
          (and
            (= (type mof07) 'STR)
            (= (type mof08) 'STR)
          )
            (progn
              (setq mof52 (strlen mof07))
              (setq mof61 1)
                (while (<= mof61 mof52)
                  (setq mof62 (substr mof07 mof61 1))
                    (if (/= mof62 mof08)
                      (progn
                        (setq mof63 nil)
                        (setq mof61 (1+ mof61))
                      )
                    )
                    (if (= mof62 mof08)
                      (progn
                        (setq mof63 mof61)
                        (setq mof61 (1+ mof52))
                      )
                    )
                )
            )
            (setq mof63 nil)
        )
      mof63
    )
    (defun mfo17 (mof09 mof10 / )
      (vl-catch-all-apply 'setvar (list mof09 mof10))
    )
    (defun mfo18 (mof11 / mof64)
      (setq mof64 (fix mof11))
        (if (= (type mof64) 'INT)
          (itoa mof64)
          (rtos mof64 (getvar "LUNITS") 0)
        )
    )
    (defun mfo19 (mof12 mof13 mof14 / mof65 mof66 mof67)
      (setq mof65 (entlast))
      (command "._offset" mof12 mof13 (car mof14) "")
        (if
          (and
            (setq mof66 (cadr (cadr mof14)))
            (setq mof67 (mfo04 mof65))
          )
            (progn
              (while mof67
                (vla-put-Layer (vlax-ename->vla-object (car mof67)) mof66)
                (setq mof67 (cdr mof67))
              )
            )
        )
    )
    (defun mfo20 (mof15 / mof68 mof69 mof64)
      (setq mof68 (strcase (setq mof69 (vla-get-Layer (vlax-ename->vla-object (car mof15))))))
      (setq mof15 (cdr mof15))
      (setq mof64 mof69)
        (while mof15
            (if (/= (strcase (vla-get-Layer (vlax-ename->vla-object (car mof15)))) mof68)
              (progn
                (setq mof15 nil)
                (setq mof64 "variiert")
              )
            )
          (setq mof15 (cdr mof15))
        )
      mof64
    )
  (if (mfo10)
    (progn
      (vl-load-com)
      (setq mof70 (vla-get-ActiveDocument (vlax-get-acad-object)))
      (setq mof71 *error*)
      (setq *error* mfo03)
      (vla-EndUndoMark mof70)
      (vla-StartUndoMark mof70)
      (mfo05)
        (if mof71
          (setq *error* mof71)
          (setq *error* nil)
        )
      (vla-EndUndoMark mof70)
    )
  )
  (princ)
)
(terpri)
(princ "\nAutoLISP-Tool ACM-MOFFSET (Copyright © 2023 Gerhard Rampf) geladen.")
(princ "\nRufen Sie den Befehl mit ACM-MOFFSET auf.")
