Type de lignes

[baberise]

Bonjour,

 

 

Je souhaiterai savoir si il est possible à partir d'un fichier autocad récuperer un type de lignes sur mon ficher acadlin.

En faite j'ai déja un type de ligne definis sur un plan mais qui ne fais pas partie de mon fichiers acadlin, je voudrais la rajouter a mon acadlin sans la recreer via le bloc note.

Est ce possible?

A savoir qu'au total je dois en avoir une dizaine a récuperer.

[lecrabe]

Hello

 

Tu cherches un truc de ce genre :

 

;|

TO-LIN.LSP -- (c) 2000 Tee Square Graphics

TO-LIN is a useful AutoLISP routine that extracts parameters for
unknown LineTypes in a drawing, and creates entries in a new LineType
definition file, NEWLT.LIN. After extraction, the LineType definitions
may be moved to AutoCAD.LIN or any other *.LIN file desired by the user.

This version of TO-LIN.LSP functions fully with simple LineTypes, and
Complex LineTypes composed of linear elements and Text objects. Because
of difficulty in extracting Shape data from shape definition (*.shx)
files, the user may, for the time being, have to supply the appropriate
name for the Shape represented by {Shape #nnn} in NEWLT.LIN, in cases
where an associated Shape Source File (*.shp) is unavailable.

|;

(defun C:TO-LIN (/ ltname tblent flag tblist i outf desc alist acode value
								 rot shpno shxfl shpfl inf dat n shpnm flg txt sty)
(setq ltname (getstring "\nLineType to retrieve: "))
(if (setq tblent (tblobjname "ltype" ltname))
	(progn
		(setq flag (findfile "newlt.lin")
					tblist (entget tblent)
					i 1
					outf (open (if flag flag "newlt.lin")(if flag "a" "w"))
					desc "A,")
		(setvar "luprec" 8)
		(setvar "auprec" 8)
		(if (null flag)
			(progn
				(write-line ";;" outf)
				(write-line ";; New LineType descriptions extracted" outf)
				(write-line ";; from existing drawing(s) by TO-LIN.LSP." outf)
				(write-line ";;" outf)
				(write-line ";; TO-LIN.LSP (c) 2000 Tee Square Graphics" outf)
				(write-line ";;\n" outf)))
		(write-line (strcat "*" (cdr (assoc 2 tblist)) "," (cdr (assoc 3 tblist))) outf)
		(while (				(setq alist (nth i tblist)
						acode (car alist)
						value (cdr alist))
			(cond
				((= acode 49)
					(setq desc (strcat desc (trim (rtos value 2 8)) ",")))
				((= acode 74)
					(setq flag (if (= (logand value 4) 4) T nil)
								rot (if (= (logand value 1) 1) "a" "r")))
				((= acode 75)
					(setq shpno (itoa value)))
				((= acode 340)
					(if flag
						(progn
							(setq shxfl (cdr (assoc 3 (entget value)))
										shpfl (strcat (substr shxfl 1 (- (strlen shxfl) 3)) "shp"))
							(if (setq inf (findfile shpfl))
								(progn
									(setq inf (open inf "r"))
									(while (setq dat (read-line inf))
										(if (wcmatch dat (strcat "`*" shpno "*"))
											(progn
												(setq n 1)
												(repeat 2
													(while (/= (substr dat n 1) ",")
														(setq n (1+ n)))
													(setq n (1+ n)))
												(setq shpnm (substr dat n)))))
									(close inf)))))
					(setq flg flag
								txt (if flag
											(if shpnm shpnm (strcat "{Shape #" shpno "}"))
											(strcat "\"" (cdr (assoc 9 (member alist tblist))) "\""))
								sty (if flag
											(cdr (assoc 3 (entget value)))
											(cdr (assoc 2 (entget value))))
								desc (strcat desc "\n[" txt "," sty ",s="
														 (trim (rtos (cdr (nth (1+ i) tblist)) 2 8)) "," rot "="
														 (trim (angtos (cdr (nth (+ i 2) tblist)) 0 8)) ",x="
														 (trim (rtos (cdr (nth (+ i 3) tblist)) 2 8)) ",y="
														 (trim (rtos (cdr (nth (+ i 4) tblist)) 2 8)) "],\n")
								i (+ i 4)))
				(T nil))
			(setq i (1+ i)))
		(write-line (substr desc 1 (1- (strlen desc))) outf)
		(write-line " " outf)
		(close outf)
		(if (and flg (not shpnm))
			(alert (strcat "LineType " ltname " written (or appended) to NEWLT.LIN.\n"
										 "This is a Complex LineType using one or more Shape files\n"
										 "for which no Source File(s) (*.shp) could be found, and\n"
										 "will require the Shape Name(s) to be substituted for the\n"
										 "information contained in curly braces { }."))
			(alert (strcat "LineType " ltname " written (or appended) to NEWLT.LIN"))))
	(alert (strcat "LineType " ltname " not found!")))
(princ)
)
(defun trim (x / i)
(setq i (strlen x))
(while (= (substr x i) "0")
	(setq i (1- i)
				x (substr x 1 i)))
(if (= (substr x i) ".")
	(substr x 1 (1- i))
	x)
)

 

Le Decapode

 

 

 

 

[Edité le 18/4/2009 par lecrabe]