Updated Lisp:;| Linetype Thief
BY: Tom Beauford
updated for Upright Rotation type 1/29/2018
with thanks to roy_043 "gc 74 contains the undocumented bit value 8 for 'U=' (Upricht) embedded text."
http://www.theswamp.org/index.php?topic=53900.msg585559#msg585559
and ronjonp for removing trailing zeros
https://www.theswamp.org/index.php?topic=50109.msg552917#msg552917
BeaufordT@LeonCountyFL.gov
LEON COUNTY PUBLIC WORKS ENGINEERING SECTION
Macro: ^P(or C:lt_thf (load "LT_thief.lsp"));lt_thf
Command line: (load "LT_thief.lsp") lt_thf
==============================================================================|;
(defun c:lt_thf ( / *error* ca str1 Trim0s lt el n sn n1 csc csf FILE TEXT)
(defun *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 *error*( msg )
(defun ca (num) ;Group Code Description
(cdr (assoc num el))
)
(defun Trim0s (xb)
(if (= (type xb) 'real)
(vl-string-right-trim "." (vl-string-right-trim "0" (vl-princ-to-string xb)))
(itoa xb)
)
)
(setq lt (getvar "celtype")) ; Current Linetype
(if (or (eq lt "ByLayer")(eq lt "ByBlock")(eq lt "Continuous"))(exit)) ; Exit if there is no Linetype currently set.
(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 str1 "\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 n1 2 ;linetype element counter 2 = 3rd element
str1 "" ;blank str1
sn (- (length (cdr el))
(length (member (assoc 49 (cdr el))(cdr el))) -1)
)
(princ ",[")
(repeat sn
(cond
((= 9 (car (nth n1 el))) ;Text string
(setq str1 (strcat "\"" (cdr (nth n1 el)) "\"," str1)) ;"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 str1 (strcat TEXT ","
(cdr (assoc 3 (entget (ca 340))))))
);progn
(setq str1 (strcat str1
(cdr (assoc 2 (entget (ca 340))))))
);if (= 4 (ca 74))
)
((= 46 (car (nth n1 el))) ;Scale
(if(/= 0.0 (cdr (nth n1 el)))
(setq str1 (strcat str1 ",s=" (Trim0s(cdr (nth n1 el))))))
)
((= 50 (car (nth n1 el))) ;Rotation
(cond
((/= 0 (logand 8 (ca 74))) (setq str1 (strcat str1 ",u="))) ;Upright Rotation
((/= 0 (logand 1 (ca 74))) (setq str1 (strcat str1 ",a="))) ;Absolute Rotation
((/= 0.0 (cdr (nth n1 el))) (setq str1 (strcat str1 ",r="))) ;Relative Rotation
)
(cond
((/= 0.0 (cdr (nth n1 el))) (setq str1 (strcat str1 (Trim0s(/(* 180(cdr (nth n1 el))) pi))))) ;Relative Rotation
((/= 0 (logand 9 (ca 74))) (setq str1 (strcat str1 (itoa 0))))
)
);(= 50 (car (nth n1 el))) ;Rotation
((= 44 (car (nth n1 el))) ;X offset
(if(/= 0.0 (cdr (nth n1 el)))
(setq str1 (strcat str1 ",x=" (Trim0s(cdr (nth n1 el))))))
)
((= 45 (car (nth n1 el))) ;Y offset
(if(/= 0.0 (cdr (nth n1 el)))
(setq str1 (strcat str1 ",y=" (Trim0s(cdr (nth n1 el))))))
)
);cond
(setq n1 (+ 1 n1)) ;linetype element counter -> next
);repeat sn
(princ str1)
(princ "]")
);progn
);if (< 0 (ca 74))
(setq el (cdr el))
(setq el (member (assoc 49 el) el))
);repeat n
(textscr)
(princ)
)
It outputs the Linetype Definition to the Command line where it can be copied and pasted into a *.lin file.