autocad/layout-build.lsp

88 lines
2.6 KiB
Common Lisp

(defun c:LayoutBuild ( / ss count i ent val layoutLabels curFolder dwgFolder dwgName newDoc baseName baseNum basePrefix numStr numLen)
(princ "\nScanning model space for layout labels...")
;; Get all text entities in model space
(setq ss (ssget "_X" '((0 . "TEXT")(410 . "Model"))))
(setq count 0 layoutLabels '())
(if ss
(progn
(setq i 0)
(while (< i (sslength ss))
(setq ent (ssname ss i))
(setq val (strcase (cdr (assoc 1 (entget ent)))))
(if (wcmatch val "LAYOUT [0-9]*")
(progn
(setq layoutLabels (cons val layoutLabels))
(princ (strcat "\nFound: " val))
(setq count (1+ count))
)
)
(setq i (1+ i))
)
(setq layoutLabels (reverse layoutLabels))
(princ (strcat "\nTotal layouts found: " (itoa count)))
)
(princ "\nNo layout labels found.")
)
;; Prompt for base name with default
(initget 1)
(setq baseName (getstring T "\nEnter base name <hello-something-100>: "))
(if (= baseName "")
(setq baseName "hello-something-100")
)
;; Extract numeric suffix
(setq numStr "")
(setq i (1- (strlen baseName)))
(while (and (>= i 0) (>= (ascii (substr baseName (1+ i) 1)) 48) (<= (ascii (substr baseName (1+ i) 1)) 57))
(setq numStr (strcat (substr baseName (1+ i) 1) numStr))
(setq i (1- i))
)
(if (= numStr "")
(progn
(princ "\nError: Base name must end with a number.")
(exit)
)
)
(setq basePrefix (substr baseName 1 i))
;; If the last char of the prefix is a separator, keep it
(if (and (> i 0)
(wcmatch (substr baseName (1+ i) 1) "-_/"))
(setq basePrefix (strcat basePrefix (substr baseName (1+ i) 1)))
)
(setq baseNum (atoi numStr))
(setq numLen (strlen numStr))
;; Check if current drawing is saved
(setq curFolder (getvar "DWGPREFIX"))
(if (or (not curFolder) (= curFolder ""))
(progn
(princ "\nError: Please save the current drawing first.")
(exit)
)
)
;; Ensure the path doesn't end with double backslash
(setq dwgFolder
(if (= (substr curFolder (strlen curFolder) 1) "\\")
(strcat curFolder "drawings")
(strcat curFolder "\\drawings")
)
)
;; Create each layout as a new DWG file and close it
(foreach label layoutLabels
(setq dwgName (strcat dwgFolder "\\" basePrefix "-" (rtos baseNum 2 0) ".dwg"))
(princ (strcat "\nCreating drawing: " dwgName))
(setq newDoc (vla-add (vla-get-documents (vlax-get-acad-object))))
(vla-saveas newDoc dwgName)
(vla-close newDoc :vlax-false)
(setq baseNum (1+ baseNum))
)
(princ "\nAll drawings created and closed.")
(princ)
)