Topic: Extract Linetype Definition with Upright Rotation U=

[tombu]

I wrote a lisp to do this in r14 http://forums.augi.com/showthread.php?5328-Export-linetype-definitions&p=31701&viewfull=1#post31701 many years ago and http://www.turvill.com/t2/free_stuff/index.htm posted two as well TO-LIN.LSP & NEW-LIN.LSP, but I haven't found one that can detect upright rotation as there are DXF Group codes that cover S =, R=, A=, X=, and Y=, but not U=.

The Linetype Definitions must be stored somewhere else in the drawing.

Does anyone know how to access this or of a lisp that can do it?

[roy_043]

Both quoted examples use (tblobjname "ltype" ...) which is the correct place to look. You will find that gc 74 contains the undocumented bit value 8 for 'U=' (Upricht) embedded text.

[tombu]

Thank you!  Can't wait to update my code on Monday.  Small thing that's bugged me for years.  As it's been in there for 8 versions it should have been added to the 2018 DXF Reference by now: http://help.autodesk.com/view/ACD/2018/ENU/?guid=GUID-F57A316C-94A2-416C-8280-191E34B182AC

I realize the program functionality more important, but they really need to tighten up on help and reference information.

[tombu]

Updated Lisp:

Code: [Select]

;| 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.