LISP: export linetype from dra
;;; ----------- LTExtract - Version 1.1 -----------;;; Copyright (C) 2002-2008by ResourceCAD International;;; Author: K.E. Blackie;;; ;;; ;;; BCI COMPUTER SOLUTIONS PROVIDES THIS PROGRAM "AS IS" AND WITH;;; ALL FAULTS. RESOURCECAD INTERNATIONAL SPECIFICALLY DISCLAIMS ANY;;; IMPLIED WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR;;; USE.RESOURCECAD INTERNATIONAL DOES NOT WARRANT THAT THE OPERATION;;; OF THE PROGRAM WILL BE UNINTERRUPTED OR ERROR FREE.;;; ;;; ;;; ResouceCAD International;;; http://www.resourcecad.com;;; ;;; DESCRIPTION;;; LTExtract will extract all of the linetypes defined in a drawing to a seperate;;; linetype definition file, including complex linetypes using text and shape;;; modifiers.;;;;;; August 17, 2002;;; April 23, 2008;;;;;; ------------------------------------------------------------(defun c:ltextract () (setq ltlist (tblnext "LTYPE" t)) (if ltlist (setq ltlist (entget (tblobjname "LTYPE" (cdr (assoc 2 ltlist))))) ) (setq ltfile (getvar "dwgname")) (if (= (strcase (substr ltfile (- (strlen ltfile) 3) 4)) (strcase ".dwg") ) (setq ltfile (strcat (substr ltfile 1 (- (strlen ltfile) 4)) ".lin") ) (setq ltfile (strcat ltfile ".lin")) ) (setq ltfile (getfiled "Save Linetype Definition As" ltfile "lin" 9)) (if ltfile (progn (setq fn (open ltfile "w")) (while ltlist (setq ltname (strcat "*" (strcase (cdr (assoc 2 ltlist)))) ltdesc (cdr (assoc 3 ltlist)) ) (setq ltdef "A" wval nil ) (setq ltlist (member (assoc 49 ltlist) ltlist)) (while (assoc 49 ltlist) (setq wval (get74 ltlist)) (setq def (cdr (assoc 49 ltlist))) (setq def (strcat "," (rtos def 2 )) (if wval (setq ltdef (strcat ltdef wval def)) (setq ltdef (strcat ltdef def)) ) (if (> (length ltlist) 1) (setq ltlist (cdr (member (assoc 49 ltlist) ltlist))) (setq ltlist (list nil)) ) ) (setq ltlist (tblnext "LTYPE")) (if ltlist (progn (setq ltlist (entget (tblobjname "LTYPE" (cdr (assoc 2 ltlist))) ) ) ) ) (if (/= ltdef "A") (progn (write-line (strcat ltname "," ltdesc) fn) (write-line ltdef fn) ) ) ) (close fn) ) ) (princ))(defun get74 (wlist / rval) (setq ass74 (cdr (assoc 74 wlist))) (cond ((= ass74 0) (return nil nil nil nil)) ((= ass74 1) (return (cdr (assoc 2 (entget (cdr (assoc 340 wlist))))) nil "a" nil ) ) ((= ass74 2) (return (cdr (assoc 2 (entget (cdr (assoc 340 wlist))))) (cdr (assoc 9 wlist)) "r" nil ) ) ((= ass74 3) (return (cdr (assoc 2 (entget (cdr (assoc 340 wlist))))) (cdr (assoc 9 wlist)) "a" nil ) ) ((= ass74 4) (return (cdr (assoc 3 (entget (cdr (assoc 340 wlist))))) nil "r" (cdr (assoc 75 wlist)) ) ) ((= ass74 5) (return (cdr (assoc 3 (entget (cdr (assoc 340 wlist))))) nil "a" (cdr (assoc 75 wlist)) ) ) (T (return nil nil nil nil)) ) rval)(defun return (shx text rot shp / ttext) (setq test (cdr (assoc 50 wlist))) (if (and test rot) (setq rot (strcat rot "=" (angtos test))) ) (setq test (cdr (assoc 46 wlist))) (if (and test rot) (setq rot (strcat rot ",S=" (rtos test 2 )) ) (setq test (cdr (assoc 44 wlist))) (if (and test rot) (setq rot (strcat rot ",X=" (rtos test 2 )) ) (setq test (cdr (assoc 45 wlist))) (if (and test rot) (setq rot (strcat rot ",Y=" (rtos test 2 )) ) (if text (setq ttext (strcat ",[\"" text "\"," shx "," rot "]")) ) (if (and (not text) shp) (setq ttext (strcat ",[" (getname shp shx) "," shx "," rot "]")) ) (setq rval ttext))(defun getname (shape shapefile) (setq shapefile (findfile shapefile)) (if (setq sfn (open shapefile "r")) (progn (repeat 23 (read-char sfn) ) (setq lownum (read-char sfn)) (read-char sfn) (setq charcount (- shape lownum)) (setq hignum (read-char sfn)) (read-char sfn) (setq shpcount (read-char sfn)) (read-char sfn) (repeat (* shpcount 4) (read-char sfn) ) (setq zerocount 0) (while (< zerocount (* charcount 2)) (setq this (read-char sfn)) (if (= this 0) (setq zerocount (1+ zerocount)) ) ) (setq char1 (read-char sfn)) (setq name "") (while (/= 0 char1) (setq name (strcat name (chr char1))) (setq char1 (read-char sfn)) ) (close sfn) name ) ))(princ)Here is a lisp that found on internet, but not works (for me), can anyone try to see what happened here?? THX...This lisp could be very usable for everyone..
Here is page where I picked it up..
http://www.theswamp.org/index.php?topic=506.msg6241 Try to use the a bit changed code. See post #8.
Changes: You could also post this to theswamp, I am sure that Keith would be more than happy to help you.
页:
[1]