Tuesday, April 28, 2009

Export Linetypes

Cadalyst sent me a tips and tricks email with the promise of a link to a lisp file written by Douglas Lerner to export linetypes from a drawing to a LIN file. But, there seems to be a bit of a broken link. I searched their site and came up with a lisp written in 1995 by Greg Oliver. Find it here, or copy paste from below.


; TIP1076.LSP: LLTYPES.LSP Extract Linetypes (c)1995, Greg Oliver

(defun dxf (CODE ELIST)
(cdr (assoc CODE ELIST))
)

(defun C:LLTYPES (/ LT WISH LTL LTS LTSM NDLI N LTN LTDES LTDEF DL STR LTFW LTFR FLAG)
(setq LT (tblnext "LTYPE" T)) ;first ltype
(initget 1 "Yes No") ;Establish keywords, no null
(setq WISH (getkword "\nWrite Linetype definitions to a file (Y/N) ? "))
(if (= WISH "Yes")
(progn
(setq LTFW (open "ltypes.lin" "a")) ;linetype file (for writing)
)
)
(while LT
(setq N 0
LTN (dxf 2 LT) ;ltype name
LTDES (dxf 3 LT) ;ltype description
NDLI (dxf 73 LT) ;number of dashed items
)
(if (> NDLI 0)
(progn
(setq ltl (member (assoc 49 lt) lt) ;list of "49" groups - dashed items
LTS (strcat "*" ltn ",") ;linetype string - eg. "*DASHED,"
LTSM (strcat "`*" ltn "`,*") ;string used in "wcmatch" - special chars. escaped
LTDEF (strcat "A") ;linetype definition + alignment code
DL 0
)
(while (setq DL (cdr (nth N LTL)))
(setq LTDEF (strcat LTDEF "," (rtos DL))
N (1+ N)
)
)
(if (= WISH "Yes")
(progn
(setq FLAG "write")
(setq LTFR (open "ltypes.lin" "r")) ;linetype file (for reading)
(while (/= (setq STR (read-line LTFR)) nil)
(if (wcmatch STR LTSM) ;check if linetype is already defined in file
(progn
(princ (strcat "\nLinetype " ltn " is already defined in ltypes.lin"))
(setq FLAG "nowrite")
)
)
)
(close LTFR)
(if (= FLAG "write") ;write linetype information to a file ?
(progn
(princ (strcat "\nWriting " ltn " definition to ltypes.lin"))
(princ (strcat LTS LTDES "\n") LTFW) ;linetype name & description
(princ (strcat LTDEF "\n") LTFW) ;definition
)
)
)
(progn
(princ (strcat LTS LTDES "\n"))
(princ (strcat LTDEF "\n"))
)
)
)
)
(setq LT (tblnext "LTYPE"))
)
(if LTFW (close LTFW)) ;if linetype file was opened, close it.
(princ)
)
(c:lltypes); end lltypes.lsp
__________________
Post a Comment