Hi
Give the following a try, comes from an old ACAD Guild post by Tom Beauford -
<snip>
There was a few bugs with my origional submission which had been written for r14. I haven't found a way to update the submission on the Exchange Page, but here is an updated one debuged for 2k2:
Code:
(defun c:lt_thf (/ OldErr ca I:Error lt el n sn n1 csc csf FILE TEXT)
(setq OldErr *error*)
(defun ca (num) ;Group Code Description
(cdr (assoc num el))
)
(defun I:Error (msg)
(if
(and
(/= msg nil)
(member
(strcase msg t)
'("console break" "function cancelled" "quit / exit abort")
)
) ;and
(princ (strcat "\nCurrent Linetype = " lt))
) ;if
) ;defun I:Error( msg )
(setq *error* I:Error) ; replace active errorhandler
(setq lt (getvar "celtype"))
(if (or (eq lt "ByLayer")
(eq lt "ByBlock")
(eq lt "Continuous")
)
(exit)
)
(setq *error* OldErr
I:Error nil
) ; reset errorhandler to previous
(setq el (member (cons 2 (getvar "celtype"))
(entget (tblobjname
"ltype"
(getvar "celtype")
)
)
)
)
(princ "\n*")
(princ (ca 2)) ;Name
(if (< 0 (strlen (ca 3)))
(progn
(princ ",") ;Name,
(princ (ca 3)) ;Name,Description
)
)
(princ "\n")
(setq str "\n")
(princ (chr (ca 72))) ;A
(setq n (ca 73) ;n=The number of linetype elements.
el (member (assoc 49 el) el)
)
(repeat n ;Do once for each element.
(princ ",") ;A,
(princ (ca 49)) ;Dash, dot or space length.
(if (< 0 (ca 74))
(progn
(setq old_dimzin (getvar "dimzin")
n1 2 ;linetype element counter 2 = 3rd element
str "" ;blank str
sn (- (length (cdr el))
(length (member (assoc 49 (cdr el)) (cdr el)))
-1
)
)
(setvar "dimzin" 8) ;Suppresses trailing zeros.
(princ ",[")
(repeat sn
(cond
((= 9 (car (nth n1 el))) ;Text string
(setq str (strcat "\"" (cdr (nth n1 el)) "\"," str))
;"Text"
) ;(cdr (nth n1 el)) = The nth element of el
((= 75 (car (nth n1 el))) ;Complex Shape Code
(setq csc (cdr (nth n1 el)))
) ;(cdr (nth n1 el)) = The nth element of el
((= 340 (car (nth n1 el))) ;Compiled Shape Entity
(if (= 4 (ca 74)) ;4 = embedded shape
(progn
(setq
csf (strcase (cdr (assoc 3 (entget (ca 340)))) T)
)
;csf = Compiled Shape File Name in lowercase
(if (wcmatch csf "*.shx")
(setq csf (substr csf 1 (- (strlen csf) 4)))
)
(setq csf (strcat csf ".shp"))
;csf = Shape File Name in lowercase
(setq FILE
(open (findfile csf) "r") ;Open Shape File Name
) ;setq FILE
(setq TEXT1 "")
(while (/= csc TEXT1)
(setq TEXT (read-line FILE))
(while (not (equal "*" (substr TEXT 1 1)))
(setq TEXT (read-line FILE))
)
(setq TEXT (substr TEXT 2))
(setq TEXT1 (substr TEXT 1 1))
(while (and (not (equal "," (substr TEXT 1 1)))
(> (strlen TEXT) 4)
)
(setq TEXT (substr TEXT 2))
(setq TEXT1 (strcat TEXT1 (substr TEXT 1 1)))
)
(setq TEXT1 (atof TEXT1))
(setq TEXT (substr TEXT 2))
(while (and (not (equal "," (substr TEXT 1 1)))
(> (strlen TEXT) 3)
)
(setq TEXT (substr TEXT 2))
)
(setq TEXT (substr TEXT 2))
) ;while (/= csc TEXT1)
(close FILE)
(setq str (strcat TEXT
","
(cdr (assoc 3 (entget (ca 340))))
)
)
) ;progn
(setq str (strcat str (cdr (assoc 2 (entget (ca 340))))))
) ;if (= 4 (ca 74))
)
((= 46 (car (nth n1 el))) ;Scale
(if (/= 0.0 (cdr (nth n1 el)))
(setq str (strcat str ",s=" (rtos (cdr (nth n1 el)))))
)
)
((= 50 (car (nth n1 el))) ;Rotation
(if (/= 0.0 (cdr (nth n1 el)))
(setq
str (strcat str
",r="
(rtos (/ (* 180 (cdr (nth n1 el))) pi))
)
)
)
)
((= 44 (car (nth n1 el))) ;X offset
(if (/= 0.0 (cdr (nth n1 el)))
(setq str (strcat str ",x=" (rtos (cdr (nth n1 el)))))
)
)
((= 45 (car (nth n1 el))) ;Y offset
(if (/= 0.0 (cdr (nth n1 el)))
(setq str (strcat str ",y=" (rtos (cdr (nth n1 el)))))
)
)
) ;cond
(setq n1 (+ 1 n1)) ;linetype element counter -> next
) ;repeat sn
(princ str)
(princ "]")
) ;progn
) ;if (< 0 (ca 74))
(setq el (cdr el))
(setq el (member (assoc 49 el) el))
) ;repeat n
(if (= old_dimzin nil)
(setvar "dimzin" 0)
(setvar "dimzin" old_dimzin)
)
(princ)
)
</snip>
Have a good one, Mike