Hromadný DWG import do jednoho výkresu

Funkce umožňuje hromadný import vícero DWG souborů do jednoho. Všechny DWG se vloží do stejného bodu [0,0,0]. Po spuštění příkazu MERGEDWG vyberte složku ve které se nachází požadované DWG soubory.

---

;;; ================================================================
;;; MERGEDWG.lsp
;;; Hromadne vlozeni vsech DWG souboru ze zvolene slozky do
;;; AKTUALNIHO (jiz otevreneho) vykresu, vsechny na souradnici 0,0.
;;; Kazdy DWG se vlozi jako blok (INSERT), ktery se hned rozlozi
;;; (EXPLODE) na normalni entity - tim se zachovaji puvodni hladiny,
;;; styly textu, kotani apod. z kazdeho zdrojoveho souboru.
;;;
;;; POZOR: pred spustenim mej otevreny/pripraveny cilovy vykres,
;;; do ktereho se ma vse sloucit.
;;; ================================================================

(defun readTextFileLine (path / f line)
  (setq line nil)
  (if (setq f (open path "r"))
    (progn
      (setq line (read-line f))
      (close f)
    )
  )
  line
)

(defun c:MERGEDWG ( / *error* oldFiledia oldCmdecho oldExpert
                       tmpfile psScript waitCount folder
                       files f dwgPath okCount errList )

  (defun *error* (msg)
    (if oldFiledia (setvar "FILEDIA" oldFiledia))
    (if oldCmdecho (setvar "CMDECHO" oldCmdecho))
    (if oldExpert  (setvar "EXPERT"  oldExpert))
    (if (and msg (not (member msg '("Function cancelled" "quit / exit abort"))))
      (princ (strcat "\nChyba: " msg)))
    (princ)
  )

  (setq oldFiledia (getvar "FILEDIA"))
  (setq oldCmdecho (getvar "CMDECHO"))
  (setq oldExpert  (getvar "EXPERT"))

  ;; --- vyber slozky s DWG soubory pres skutecny Windows dialog ---
  (setq tmpfile (strcat (getenv "TEMP") "\\mergedwg_folder.txt"))
  (if (findfile tmpfile) (vl-file-delete tmpfile))

  (setq psScript
    (strcat
      "powershell -NoProfile -STA -WindowStyle Hidden -Command "
      "\"Add-Type -AssemblyName System.Windows.Forms; "
      "$f = New-Object System.Windows.Forms.FolderBrowserDialog; "
      "$f.Description = 'Vyberte slozku s DWG soubory ke slouceni'; "
      "if ($f.ShowDialog() -eq 'OK') { [System.IO.File]::WriteAllText('" tmpfile "', $f.SelectedPath) } "
      "else { [System.IO.File]::WriteAllText('" tmpfile "', 'CANCELLED') }\""
    ))

  (startapp psScript)

  (princ "\nOtevira se dialog pro vyber slozky, cekejte...")
  (setq waitCount 0)
  (while (and (not (findfile tmpfile)) (< waitCount 180))
    (command "_.DELAY" 500)
    (setq waitCount (1+ waitCount))
  )

  (if (not (findfile tmpfile))
    (princ "\nCasovy limit pro vyber slozky vyprsel.")
    (progn
      (setq folder (readTextFileLine tmpfile))
      (if (findfile tmpfile) (vl-file-delete tmpfile))

      (if (or (not folder) (= folder "CANCELLED") (= folder ""))
        (princ "\nVyber slozky byl zrusen.")

        (progn
          (setq files (vl-directory-files folder "*.dwg" 1))

          (if (not files)
            (princ (strcat "\nVe slozce " folder " nebyly nalezeny zadne DWG soubory."))
            (progn
              (setq okCount 0 errList '())
              (setvar "FILEDIA" 0)
              (setvar "CMDECHO" 1)
              (setvar "EXPERT" 5)

              (princ (strcat "\nNalezeno " (itoa (length files)) " DWG souboru ve slozce " folder))

              (foreach f files
                (setq dwgPath (strcat folder "\\" f))
                (princ (strcat "\n\n=== Vkladam: " f " ==="))

                ;; vlozit jako blok na 0,0, meritko 1,1, rotace 0
                (command "_.-INSERT" dwgPath "0,0" "1" "1" "0")

                ;; hned rozlozit posledni vlozeny blok na entity
                ;; (zachova puvodni hladiny jednotlivych entit)
                (command "_.EXPLODE" "L" "")

                (setq okCount (1+ okCount))
                (princ (strcat "\n>>> OK -> " f))
              )

              (setvar "FILEDIA" oldFiledia)
              (setvar "CMDECHO" oldCmdecho)
              (setvar "EXPERT" oldExpert)

              (princ (strcat "\n\nHotovo. Vlozeno a rozlozeno: " (itoa okCount)
                              " z " (itoa (length files)) " souboru."))
            )
          )
        )
      )
    )
  )

  (setvar "FILEDIA" oldFiledia)
  (setvar "CMDECHO" oldCmdecho)
  (setvar "EXPERT"  oldExpert)
  (princ)
)

(princ "\nPrikaz MERGEDWG nacten. Otevrete/pripravte cilovy vykres a spustte napsanim MERGEDWG")
(princ)

---

Soubor ke stažení