; From - Thu Nov 06 03:57:04 1997
; Date: Thu, 06 Nov 1997 03:57:04 +0200
; From: Vladimir Nesterovsky 
; Newsgroups: autodesk.autocad.customization
; Subject: Re: Saving old Line Types from a drawing.
; References: <3460BB20.3A73@gmgw.com> <3460C8DC.742C@autodesk.com>
;
; Here is stripped down version of some lisp file	;
; from my application that has this and much more.	;
  ;; Copyright Vladimir Nesterovsky, 1997,		;
  ;;       vnestr@netvision.net.il			;
  ;; http://www.netvision.net.il/php/vnestr		;
  ;; Use this for your own *non-commercial*		;
  ;; purposes *only*. You must keep this header.	;
  ;; {full version is available with more features	;
  ;;  like scale factor, output pattern etc.		;
  ;;  if you'd like to use it commercially}.		;

  ;; reduced for only Textscreen output => ltdump+	;
  ;;http://ww3.cad.de/foren/ubb/Forum54/HTML/026595.shtml

  (defun c:ltdump+( / dwgname olderr *error*)
   (Setq olderr *error* *error* '((s)
;;;     (if (= 'FILE (type fd))(setq fd (close fd)))
     (Setq *error* olderr) s))
   (setq dwgname
    (if (>= (atoi (getvar "acadver")) 14)
     (strcat(getvar"dwgprefix")
      ((lambda(s)(substr s 1 (- (STRLEN s) 4)))
       (getvar"dwgname")))
     (getvar "dwgname")))

;;;   (cond ((setq fd (open (strcat dwgname ".lin") "w"))
    (princ (strcat
              "\n;; LINETYPEs for file " dwgname ".dwg"
              "\n;; -- created by Vladimir Nesterovsky's program --"
              "\n;; --          vnestr@netvision.net.il          --"
              "\n;; --  http://www.netvision.net.il/php/vnestr   --\n\n"
           )
;;;	   fd
	   )
    (foreach lt
        (mapcar '(lambda(x)(cdr(mapcar'cdr x)))
          ((lambda(/ lst a)
            (while (Setq a (tblnext "LTYPE" (not a)))
              (setq lst (cons a lst)))
            (reverse lst))))
      (if (/= "CONTINUOUS" (strcase (car lt))) 
        (progn
          (princ (strcat "*"  (car lt)  ","  (caddr lt) "\nA")
;;;		 fd
		 )
          (princ (apply 'strcat
                   (mapcar '(lambda(x)(strcat ", "(rtos x 2 4)))
                            (cdddr(cdddr lt))))
;;;		 fd
		 )
          (princ "\n"
;;;		 fd
		 ))))
;;;    (setq fd (close fd))
;;;    (mapcar 'princ (list "\n Linetype definitions file " dwgname ".lin created!"))
    (princ)
;;;  )
;;;  )
)