Převod DGN či DXF souborů do DWG

Funkce zprostředkovává hromadný převod DGN a DXF souborů do DWG. Umístěte DGN a DXF soubory do jedné složky. Tu pomocí lispu (příkaz CAD2DWG) vyberte. Poté vyberte ještě verzi DWG pro export.

---

;;; ================================================================
;;; CAD2DWG.lsp
;;; Hromadny prevod DGN a DXF souboru -> DWG. Skutecny dialog pro
;;; vyber SLOZKY (System.Windows.Forms.FolderBrowserDialog spusteny
;;; externe pres PowerShell - nepouziva ActiveX/COM uvnitr 4MCAD,
;;; ktery je na tomto systemu nefunkcni). Vysledek se preda zpet
;;; do LISPu pres docasny textovy soubor.
;;; ================================================================

(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:CAD2DWG ( / *error* oldFiledia oldCmdecho oldExpert origDwgName
                         tmpfile psScript waitCount folder dwgVerze
                         files f ext dgnPath baseName dwgPath okCount errList safetyCount )

  (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)
  )

  ;; zachytit puvodni hodnoty hned na zacatku, aby se daly VZDY obnovit
  (setq oldFiledia (getvar "FILEDIA"))
  (setq oldCmdecho (getvar "CMDECHO"))
  (setq oldExpert  (getvar "EXPERT"))
  (setq origDwgName (getvar "DWGNAME"))   ; jmeno vykresu, ktery byl otevreny pred spustenim makra

  ;; --- 1) skutecny dialog pro vyber slozky pres PowerShell ---
  (setq tmpfile (strcat (getenv "TEMP") "\\dgn2dwg_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 DGN soubory k prevodu'; "
      "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.")

        ;; --- 2) hromadny prevod vsech DGN v teto slozce ---
        (progn
          (setq files (append (vl-directory-files folder "*.dgn" 1)
                               (vl-directory-files folder "*.dxf" 1)))

          (if (not files)
            (princ (strcat "\nVe slozce " folder " nebyly nalezeny zadne DGN ani DXF soubory."))
            (progn
              (setq okCount 0 errList '())
              (setvar "FILEDIA" 0)
              (setvar "CMDECHO" 1)   ; zapnute echo - videt prubeh na prikazove radce
              (setvar "EXPERT" 5)

              (princ (strcat "\nNalezeno " (itoa (length files)) " souboru (DGN/DXF) ve slozce " folder))

              ;; dotaz na verzi DWG - jednou pro celou davku
              (initget "R2.5 R2.6 R9 R10 R12 R13 R14 A2K A2004 A2007 A2010 A2013 A2018")
              (setq dwgVerze
                (getkword
                  "\nVyberte verzi vystupniho DWG [R2.5/R2.6/R9/R10/R12/R13/R14/A2K/A2004/A2007/A2010/A2013/A2018] : "
                )
              )
              (if (not dwgVerze) (setq dwgVerze "A2018"))
              (princ (strcat "\nPouzita verze DWG: " dwgVerze))

              (foreach f files
                (setq dgnPath (strcat folder "\\" f)
                      baseName (vl-filename-base f)
                      dwgPath (strcat folder "\\" baseName ".dwg")
                      ext (strcase (vl-filename-extension f)))

                (princ (strcat "\n\n=== Zpracovavam: " f " ==="))

                (cond
                  ;; --- DGN soubory: novy prazdny vykres + import ---
                  ((= ext ".DGN")
                   (command "_.NEW" ".")
                   ;; import DGN - poradi: soubor / model / jednotky / mapovani
                   (command "_.-DGNIMPORT" dgnPath "" "M" "")
                  )
                  ;; --- DXF soubory: rovnou otevrit jako novy vykres ---
                  ((= ext ".DXF")
                   (command "_.OPEN" dgnPath)
                  )
                )

                ;; ulozit jako DWG - SAVEAS se pta na DVE veci:
                ;; 1) Verze souboru [...]  -> dwgVerze = zvolena verze
                ;; 2) Ulozit vykres jako... -> dwgPath = nazev souboru
                (command "_.SAVEAS" dwgVerze dwgPath)

                ;; zavrit prave ulozeny vykres, aby se nehromadily otevrene taby
                (command "_.CLOSE")

                ;; bezpecnostni pojistka - pokud jsme se z jakehokoli duvodu
                ;; nevratili k puvodnimu vykresu (napr. zaseknuty prompt),
                ;; dozaviraj dalsi taby, dokud nejsme zpet na puvodnim vykresu
                (setq safetyCount 0)
                (while (and (/= (getvar "DWGNAME") origDwgName) (< safetyCount 5))
                  (princ (strcat "\n  (pojistka: zavírám navíc otevreny vykres "
                                  (getvar "DWGNAME") ")"))
                  (command "_.CLOSE")
                  (setq safetyCount (1+ safetyCount))
                )

                (if (findfile dwgPath)
                  (progn (setq okCount (1+ okCount)) (princ (strcat "\n>>> OK -> " dwgPath)))
                  (progn (setq errList (cons f errList)) (princ (strcat "\n>>> CHYBA pri souboru " f)))
                )
              )

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

              (princ (strcat "\n\nHotovo. Uspesne prevedeno: " (itoa okCount)
                              " z " (itoa (length files)) " souboru."))
              (if errList
                (progn
                  (princ "\nSoubory s chybou:")
                  (foreach e errList (princ (strcat "\n  - " e)))))
            )
          )
        )
      )
    )
  )

  ;; garantovane obnoveni puvodnich hodnot, bez ohledu na to, kterou vetvi
  ;; skript prosel (i pri predcasnem zruseni vyberu slozky apod.)
  (setvar "FILEDIA" oldFiledia)
  (setvar "CMDECHO" oldCmdecho)
  (setvar "EXPERT"  oldExpert)

  ;; zaverecny uklid - zavrit jakekoli navic otevrene taby z prubehu
  ;; prevodu, ale VZDY zachovat puvodni vykres, ktery byl otevreny
  ;; pred spustenim makra (na rozdil od CLOSEALL, ktery by zavrel vse)
  (setq safetyCount 0)
  (while (and (/= (getvar "DWGNAME") origDwgName) (< safetyCount 10))
    (command "_.CLOSE")
    (setq safetyCount (1+ safetyCount))
  )

  (princ)
)

(princ "\nPrikaz CAD2DWG nacten. Spustte napsanim CAD2DWG")
(princ)

---

Soubor ke stažení