Aller au contenu
Problème de lien d'inscription (résolu ?) ×

Calques - Exporter liste sur plusieurs fichiers

GregRA

Par GregRA
dans AutoCAD 2014

 Partager

Messages recommandés

GregRA Newbie

GregRA

Posté(e)
Posté(e)

Bonjour,

 

Je travaille actuellement sur un projet qui comporte plusieurs types de fluide (O2, EF, ECS, ect....).

Chaque fluide est sur un plan *dwg

J'ai donc environ 20 plans *dwg au total et cela pour un seul étage.

 

Lors de la reprise de ces plans j'ai essayer de faire attention à l’appellation des calques afin d'avoir une même logique sur tout les plans.

Cependant, pour vérifier que c'est pas trop déconnant je voudrai exporter tout les calques de chaque plans dans un ficher *xls.

J'ai cherché un peu sur le net et sur le site, je n'ai pas trouvé de solution.

Si quelqu'un à une idée, je suis preneur.

 

Bonne journée à tous.

Technicien Bureau d'Etude Génie Clim

Dessinateur-Projeteur Génie Clim

Tuyauterie installation générale

Twitter: @g_ranque

Lien vers le commentaire
Partager sur d’autres sites
bavmorda1 Newbie

bavmorda1

Posté(e)
Posté(e)

une méthode simple qui fonctionnerait sur LT également serait attextr avec un fichier gabarit qui récupèrerait le nom des calques. y a plus qu'à avoir une moulinette sous excel pour enlever les doublons.

 

il y a également le programme scandxf qui est telechargeable sur le forum et qui peut peut etre etre utile.

 

Maintenant il me semble qu'il doit exister dans les versions complètes un module pour controler les "chartes graphiques" ...

Lien vers le commentaire
Partager sur d’autres sites
rebcao Collaborator

rebcao

Posté(e)
Posté(e)

Bonjour,

 

Et sinon un truc tout bête, une fois dans la Palette des CALQUES (gestionnaire des calques) sélectionner tous les calques et faire un COPIER COLLER dans EXCEL !

 

Christian

 

 

 

Formateur, Consultant Expert AutoCAD, REVIT MEP, INVENTOR, télécharger , des Outils AutoCAD...

cad123 @ wanadoo.fr (enlever les espaces de part et d'autre de @)

Lien vers le commentaire
Partager sur d’autres sites
Olivier Eckmann Proficient

Olivier Eckmann

Posté(e)
Posté(e)

Bonjour,

 

Ci-joint le code modifié pour ajouter a transparence. Je n'ai pas touché à l'entête, n° de version ou autre.

 

;;-------------------=={ Layer Extractor }==------------------;;
;;                                                        	;;
;;  Produces a report detailing the layer structure in every  ;;
;;  drawing in a selected directory (and subdirectories). 	;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com   	;;
;;------------------------------------------------------------;;
;;  Version:  1.4  28-04-2011                 				;;
;;------------------------------------------------------------;;

(defun c:LX nil (c:LayerExtract))

(defun c:LayerExtract

  ( /

;; --=={ Local Functions }==--

*error*
_dclist
_directorymode
_directorytext
_fixdir
_getlayerproperties
_getsavepath
_logo
_padright
_popup
_readconfig
_replaceentrefs 
_writeconfig
_writedcl
_xmloptions

;; --=={ Local Variables }==--

_lxbit
_lxcur
_lxdir
_lxl
_lxpad
_lxref
_lxsl
_lxsub
acapp
acdoc
acdocs
cfgfname
ch
data
dc
dclfname
dcltitle
df
doc
ext
i
l
len
ll
ln
lst
odbx
ofile
out
p
padc
savepath
sfile
shell
str
sym
symlist
tc
tiles
title
titles
tl
val
vallist
versionnumber
x
xtitles

;; --=={ Global Variables }==--

;; -None-

  )
 
 (vl-load-com)
 ;; © Lee Mac 2010

 (setq VersionNumber "1-4")
 
 (setq titles '("Layer" "Colour" "Linetype" "Lineweight" "Plot" "PlotStyle" "On" "Locked" "Frozen" "Frozen VP" "Description" "Transparency")) ;; Headings

 ;;----------------------------------------------------------;;
 ;;     				Local Functions                  	;;
 ;;----------------------------------------------------------;;

 (defun *error* ( msg )

(if dc (unload_dialog dc))
(mapcar
 	(function
   	(lambda ( file ) (if (and file (eq 'FILE (type file))) (close file)))
 	)
 	(list ofile sfile)
)

(mapcar 'LM:ReleaseObject (list Shell odbx))

(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
   	(princ (strcat "\n** Error: " msg " **")))
(princ)
 )

 ;............................................................;
 ; gets transparency in percentage 
 (defun getLayerTransparency (layerName / layer transparency) 
(setq layer (tblobjname "LAYER" layerName)) 
; get the XData of AcCmTransparency	
(setq transparency (cdr (assoc 1071 (cdar (cdr (assoc -3 
 	(entget layer '("AcCmTransparency")))))))) 
(if (= transparency nil) 
 	; if we did not get a value it must be the default 0% 
 	(setq transparency 0) 
 	; if we got a value then calculate from it 
 	(progn 
   	; get the lower byte of the value 0..255 
   	; (100%..0% in the AutoCAD user interface) 
   	(setq transparency (lsh (lsh transparency 24) -24)) 
   	; convert the value to a percentage 
   	(setq transparency (fix (- 100 (/ transparency 2.55))))	
 	) ; (progn 
) ; (if
(itoa transparency)
 )

 ;............................................................;

 (defun _GetLayerProperties ( doc mode xref / _TF funcs l )

(defun _tf ( v ) (if (eq :vlax-true v) "YES" "NO"))

(setq funcs
	'(
   	(lambda ( x ) (getLayerTransparency (vla-get-name x)))
   	(lambda ( x ) (if  (vlax-property-available-p x 'Description) (vla-get-Description x) ""))
   	(lambda ( x ) (_tf (vla-get-ViewportDefault x)))
   	(lambda ( x ) (_tf (vla-get-Freeze	x)))
   	(lambda ( x ) (_tf (vla-get-Lock  	x)))
   	(lambda ( x ) (_tf (vla-get-Layeron   x)))
   	(lambda ( x ) (vla-get-PlotStyleName  x))
   	(lambda ( x ) (_tf (vla-get-Plottable x)))
   	(lambda ( x / w )
     	(if (minusp (setq w (vla-get-lineweight x)))
       	"DEFAULT"
       	(rtos (/ w 100.) 2 2)
     	)
   	)
   	(lambda ( x ) (vla-get-Linetype x))
   	(lambda ( x / tc )
     	(if (eq acColorMethodByACI (vla-get-ColorMethod (setq tc (vla-get-TrueColor x))))
       	(itoa (vla-get-Color x))
       	(vl-prin1-to-string
         	(LM:lst->str
           	(mapcar '(lambda ( p ) (itoa (vlax-get-property tc p))) '(Red Green Blue)) ","
         	)
       	)
     	)
   	)
   	(lambda ( x ) (vla-get-name x))
 	)
)    	

(vlax-for layer (vla-get-Layers doc)
 	(if (or xref (not (wcmatch (vla-get-name layer) "*|*")))
   	(setq l
     	(cons
       	(
         	(lambda ( i / result )
           	(foreach x funcs
             	(if (= (setq i (lsh i -1)) (logand i mode))
               	(setq result (cons ((eval x) layer) result))
             	)
           	)
           	result
         	)
         	2048
       	)
       	l
     	)
   	)
 	)
)
(vl-sort l '(lambda ( a b ) (< (car a) (car B))))
 )

 ;............................................................;
 
 (defun _PadRight ( st ch ln )
(
 	(lambda ( l )
   	(while (< (length l) ln) (setq l (cons ch l)))
   	(vl-list->string (reverse l))
 	)
 	(reverse (vl-string->list st))
)
 )

 ;............................................................;

 (defun _GetSavePath ( / tmp )
(cond  	
 	( (setq tmp (getvar 'ROAMABLEROOTPREFIX))

   	(or (eq "\\" (substr tmp (strlen tmp)))
       	(setq tmp (strcat tmp "\\"))
   	)
   	(strcat tmp "Support")
 	)
 	( (setq tmp (findfile "ACAD.pat"))

   	(setq tmp (vl-filename-directory tmp))

   	(and (eq "\\" (substr tmp (strlen tmp)))
			(setq tmp (substr tmp (1- (strlen tmp))))
   	)
   	tmp
 	)
)
 )

 ;............................................................;

 (defun _WriteConfig ( filename lst / ofile )

(if (setq ofile (open filename "w")) 
 	(progn
   	(foreach x lst (write-line (vl-prin1-to-string x) ofile))
   	
   	(setq ofile (close ofile))
   	T
 	)
)
 )

 ;............................................................;

 (defun _ReadConfig ( filename lst / ofile )

(if (and (setq filename (findfile filename))
			(setq ofile (open filename "r")))
 	(progn
   	(foreach x lst (set x (read (read-line ofile))))
   	
   	(setq ofile (close ofile))
   	T
 	)
)
 )
 
 ;............................................................;

 (defun _WriteDCL ( fname / ofile )

(if  T ;;(not (findfile fname))

 	(if (setq ofile (open fname "w"))
   	(progn
     	(foreach str

       	'(
			"//--------------------=={ Layer Extract }==-------------------//"
			"//                                                        	//"
			"//  Layer Extract Dialog Definition File to be used in    	//"
			"//  conjunction with Layer Extract LISP program.          	//"
			"//------------------------------------------------------------//"
			"//  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com   	//"
			"//------------------------------------------------------------//"
			""
			"boxcol : boxed_column {  width =  65.0; fixed_width  = true; alignment = centered; }"
			"butt12 :   	button {  width =  12.0; fixed_width  = true; alignment = centered; }"
			"space1 :   	spacer { height =   0.1; fixed_height = true;       				}"
			"pop	: popup_list   {  width =  13.6; fixed_width = true ; alignment = centered; }"
			""
			"layerextract : dialog { key = \"dctitle\"; spacer;"
			"  : text { label = \"Copyright (c) 2011 Lee Mac\"; alignment = right; }"
			""
			"  : boxcol { label = \"Fields to Extract\";"
			"	spacer;"
			""
			"	: row { alignment = centered; spacer;"
			""
			"  	: column {"
			""
			"    	: toggle { key = \"layer\"; label = \"Layer\"; value = \"1\"; is_enabled = false; }"
			""
			"    	: toggle { key = \"colour\"; label = \"Colour\"; }"
			""
			"    	: toggle { key = \"linetype\"; label = \"Linetype\"; }"
			""
			"  	}"
			""
			"  	: column {"
			"  	"
			"    	: toggle { key = \"lineweight\"; label = \"Lineweight\"; }"
			""
			"    	: toggle { key = \"plot\"; label = \"Plot\"; }"
			""
			"    	: toggle { key = \"plotstyle\"; label = \"Plot Style\"; }"
			""
			"  	}"
			""
			"  	: column {"
			""
			"    	: toggle { key = \"on\"; label = \"On\"; }"
			""
			"    	: toggle { key = \"locked\"; label = \"Locked\"; }"
			""
			"    	: toggle { key = \"frozen\"; label = \"Frozen\"; }"
			"    	"
			"  	}"
			""
			"  	: column {"
			""
			"    	: toggle { key = \"frozenvp\"; label = \"Frozen in VP\"; }"
			""
			"    	: toggle { key = \"description\"; label = \"Description\"; }"
			""
			"    	: toggle { key = \"transparency\"; label = \"Transparency\"; }"
			""
; 			"    	: spacer { height = 1.5; fixed_height = true; }"
; 			"    	"
			"  	}"
			"  	"
			"	}"
			""
			"	spacer;"
			"  }"
			"  "
			"  spacer;"
			""
			"  : boxcol { label = \"Drawing Directory\";"
			""
			"	: row {"
			""
			"  	: column {"
			""
			"    	space1;"
			"    	: text { key = \"dir_text\"; alignment = left; }"
			"    	space1;"
			""
			"  	}"
			""
			"  	: butt12 { label = \"Browse...\"; key = \"dir\"; }"
			""
			"	}"
			""
			"	: row {"
			""
			"  	: toggle { key = \"sub_dir\"; label = \"Include Sub-Directories\"; }"
			"  	: toggle { key = \"cur_dwg\"; label = \"Current Drawing Only\"   ; }"
			"  	"
			"	}"
			""
			"	spacer;"
			"  }"
			""
			"  spacer;"
			""
			"  : boxcol { label = \"Output Options\";"
			""
			"	: row {"
			""
			"  	: column {"
			""
			"    	space1;"
			"    	: text { key = \"out_text\"; alignment = left; }"
			"    	space1;"
			""
			"  	}"
			""
			"  	: butt12 { label = \"Browse...\"; key = \"browse\"; }"
			""
			"	}"
			""
			"	: row {"
			""
			"  	: column {"
			""
			"    	space1;"
			"    	: toggle { key = \"xref\"; label = \"Include XRef Layers\"; alignment = left; }"
			"    	space1;"
			""
			"  	}"
			""
			"  	: column {"
			""
			"    	space1;"
			"    	: text { key = \"pad_text\"; label = \"Padding Character:\"; alignment = right; }"
			"    	space1;"
			""
			"  	}"
			""
			"  	: column {"
			""
			"    	: pop { key = \"pad\"; }"
			"    	space1;"
			""
			"  	}"
			""
			"	}"
			"  "
			"  }"
			""
			"  spacer;"
			""
			"  : row { spacer;"
			""
			"	: butt12 { key = \"xml\"; label = \"XML\"; }"
			""
			"	: spacer { width = 3.06; fixed_width  = true;"
			"   			height = 2.06; fixed_height = true; }"
			""
			"	ok_cancel;"
			"	"
			"	: image { key = \"logo\"; alignment = centered;"
			"          	width = 16.06 ; fixed_width  = true;"
			"          	height = 2.06 ; fixed_height = true; color = -15; }"
			"  }"
			"}"
			""
			"xml : dialog { label = \"XML Options\"; spacer;"
			""
			"  : row { spacer_1;"
			""
			"	: column {"
			""
			"  	: toggle { key = \"xl\"; label = \"Excel Compatible\"; }"
			""
			"  	: toggle { key = \"xsl\"; label = \"Create XSL Stylesheet\"; }"
			""
			"	}"
			""
			"  }"
			""
			"  spacer; ok_cancel;"
			"}"
			)

       	(write-line str ofile)
     	)
     	(setq ofile (close ofile))

     	(while (not (findfile fname)))
     	t
   	)
 	)
 	t
)
 )

 ;............................................................;

 (defun _Logo ( key )
 
(start_image key)
(mapcar 'vector_image
	'(022 021 001 000 000 000 000 007 000 000 000 000 001 006 006 006 006 007 043 036 027 036 030 021 021 021 022 022 022 022
  	021 021 021 028 028 028 027 027 030 029 029 030 052 043 043 043 044 044 046 046 045 045 045 045 052 052 052 051 051 051
  	051 051 052 062 065 066 068 068 068 068 067 067 075 075 075 074 074 073 066 058 058 059 059 059 059 052 057 057 056 056
  	056 056 057 058 065 065 065 065 066 095 094 094 092 091 091 091 090 089 089 088 087 086 085 074 074 075 075 076 077 078
  	079 080 081 082 083 084 085 086 087 088 088 089 090 091 092 093 094 095 074 073 073 072 072 071 071 071 071 071 071 071
  	072 072 072 073 084 083 082 081 080 079 079 078 077 077 076 076 076 076 076 077 077 078 079 079 080 081 082 083 094 094
  	095 083 083 082 081 080 079 078 077 076 075 074 084 085 086 087 088 089 089 090 091 091 091 091 092 095 094 093 092 091
  	090 089 089 088 087 086 085 084)
	'(020 020 023 023 023 024 024 000 000 000 000 001 001 020 001 001 001 000 002 024 007 015 000 000 000 000 001 001 023 023
  	023 024 024 024 024 024 023 023 002 001 001 000 000 000 000 000 001 001 007 023 023 023 024 024 024 024 024 023 023 001
  	001 001 000 010 016 019 021 022 023 024 024 024 024 024 024 023 023 022 004 004 005 005 006 006 007 024 024 024 024 023
  	023 022 019 016 007 007 006 005 005 022 022 022 017 017 018 018 019 020 020 020 021 021 021 021 022 023 023 023 024 024
  	024 025 025 025 025 025 025 025 025 024 024 024 023 023 022 022 022 022 007 008 008 009 010 011 012 013 014 015 016 017
  	018 019 019 020 021 021 021 021 020 020 019 019 018 017 016 015 014 013 012 012 011 010 009 009 008 008 008 007 007 007
  	007 004 004 004 004 004 004 004 005 005 006 006 007 007 008 008 008 009 009 009 010 011 011 011 011 007 007 007 006 006
  	005 005 004 004 004 004 004 004)
	'(021 006 000 000 000 000 021 000 000 000 000 001 001 006 006 006 007 007 036 046 036 030 021 021 021 022 022 022 022 021
  	021 021 028 028 028 027 027 027 029 029 030 030 043 043 043 044 044 043 046 045 045 045 045 052 052 052 051 051 051 051
  	051 052 052 065 058 068 068 068 068 067 067 075 075 075 074 074 073 065 058 058 059 059 059 059 051 057 057 056 056 056
  	056 057 066 062 065 065 065 066 066 094 094 095 091 091 091 090 089 089 088 087 086 085 084 074 075 075 076 077 078 079
  	080 081 082 083 084 085 086 087 088 088 089 090 091 092 093 094 095 092 073 073 072 072 071 071 071 071 071 071 071 072
  	072 072 073 074 083 082 081 080 079 079 078 077 077 076 076 076 076 076 077 077 078 079 079 080 081 082 083 084 094 095
  	094 083 082 081 080 079 078 077 076 075 074 074 085 086 087 088 089 089 090 091 091 091 091 092 095 094 093 092 091 090
  	089 089 088 087 086 085 084 083)
	'(020 020 023 023 024 024 024 000 000 000 001 001 023 001 001 001 000 000 015 007 024 002 000 000 000 001 001 023 023 023
  	024 024 024 024 024 023 023 007 001 001 000 000 000 000 000 001 001 002 023 023 023 024 024 024 024 024 023 023 001 001
  	001 000 000 016 016 021 022 023 024 024 024 024 024 024 023 023 022 007 004 005 005 006 006 007 022 024 024 024 023 023
  	022 019 019 010 007 006 005 005 004 022 022 022 017 018 018 019 020 020 020 021 021 021 021 022 023 023 023 024 024 024
  	025 025 025 025 025 025 025 025 024 024 024 023 023 022 022 022 022 017 008 008 009 010 011 012 013 014 015 016 017 018
  	019 019 020 021 021 021 021 020 020 019 019 018 017 016 015 014 013 012 012 011 010 009 009 008 008 008 007 007 007 007
  	007 004 004 004 004 004 004 005 005 006 006 007 007 008 008 008 009 009 009 010 011 011 011 011 007 007 007 006 006 005
  	005 004 004 004 004 004 004 004)
	'(178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178
  	178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178
  	178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178
  	178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178
  	178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178
  	178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178
  	178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178 178
  	178 178 178 178 178 178 178 178)
)	
(end_image)
 )

 ;............................................................;

 (defun _FixDir ( s )
(if (eq "\\" (substr s (strlen s)))
 	(substr s 1 (1- (strlen s)))
 	s
)
 )

 ;............................................................;

 (defun _DirectoryMode ( val )
(foreach x '("sub_dir" "dir" "dir_text") (mode_tile x (atoi val)))
 )

 ;............................................................;

 (defun _DirectoryText ( key str )
(set_tile key
 	(if str
   	(if (< 50 (strlen str))
     	(strcat (substr str 1 47) "...") str
   	)
   	""
 	)
)
 )

 ;............................................................;

 (defun _dcList ( key lst )
(start_list key)
(mapcar 'add_list lst)
(end_list)
 )

 ;............................................................;

 (defun _Popup ( title flags msg / WSHShell result )

(setq WSHShell (vlax-create-object "WScript.Shell"))
(setq result   (vlax-invoke WSHShell 'Popup msg 0 title flags))
(vlax-release-object WSHShell)

result
 )

 ;............................................................;

 (defun _ReplaceEntRefs ( string / _stringsubst )

(defun _stringsubst ( new old string / i nl )
 	(setq i 0 nl (strlen new))

 	(while (and (< i (strlen string)) (setq i (vl-string-search old string i)))
   	(setq string (vl-string-subst new old string i) i (+ i nl))
 	)
 	string
)

(mapcar
 	(function
   	(lambda ( pair ) (setq string (_stringsubst (car pair) (cdr pair) string)))
 	)
	'(
   	("<"   .  "<")
   	(">"   .  ">")
   	("&"  .  "&")
   	("'" .  "'")
   	(""" . "\"")
 	)
)
string
 )

 ;............................................................;

 (defun _XMLOptions ( handle / xl xsl )	
(cond
 	(
   	(not (new_dialog "xml" handle))

   	(princ "\n** Error Loading XML Options Dialog **")
 	)
 	(t
   	(set_tile "xl"  (setq xl  _LXL ))
   	(set_tile "xsl" (setq xsl _LXSL))

   	(action_tile "xl"  "(setq xl  $value xsl (set_tile \"xsl\" \"0\"))")
   	(action_tile "xsl" "(setq xsl $value xl  (set_tile \"xl\"  \"0\"))")

   	(if (= 1 (start_dialog)) (setq _LXL xl _LXSL xsl))
 	)
)
 )

 ;;----------------------------------------------------------;;
 ;;       				Main Routine       				;;
 ;;----------------------------------------------------------;;

 (setq acapp  (vlax-get-acad-object)
   	acdoc  (vla-get-ActiveDocument acapp)
   	acdocs (vlax-for doc (vla-get-Documents acapp)
				(setq acdocs (cons (cons (strcase (vla-get-FullName doc)) doc) acdocs))
  			)
 )

 (if (not (vl-file-directory-p (setq SavePath (_GetSavePath))))
(progn
 	(princ "\n** Save Path not Valid **") (exit)
)
 )

 (setq dclfname (strcat SavePath "\\LMAC_LayerExtract_V" VersionNumber ".dcl")
   	cfgfname (strcat SavePath "\\LMAC_LayerExtract_V" VersionNumber ".cfg")
   	dcltitle (strcat "Layer Extractor V" (vl-string-translate "-" "." VersionNumber))
 )

 (setq SymList '(_LXDir _LXCur _LXSub _LXBit _LXRef _LXPad _LXL _LXSL)
   	ValList  (list (_FixDir (getvar 'DWGPREFIX)) "0" "0" 2047 "0" "0" "0" "1")
 )

 (or (findfile cfgfname)
 	(_WriteConfig cfgfname ValList)
 )

 (_ReadConfig cfgfname SymList)

 (mapcar '(lambda ( sym val ) (or (boundp sym) (set sym val))) SymList ValList)
 
 ;............................................................;

 (cond
(
 	(not (_WriteDCL dclfname))

 	(princ "\n** Error Writing DCL File **")
)
(
 	(<= (setq dc (load_dialog dclfname)) 0)

 	(princ "\n** Error Loading DCL File **")
)
(
 	(not (new_dialog "layerextract" dc))

 	(setq dc (unload_dialog dc))
 	(princ "\n** Error Loading Dialog Interface **")
)
(t

 	(setq tiles '("colour" "linetype" "lineweight" "plot" "plotstyle" "on" "locked" "frozen" "frozenvp" "description" "transparency"))

 	(set_tile "dctitle" dcltitle)

 	(_DirectoryText "dir_text" _LXDir)
 	(set_tile   	"sub_dir"  _LXSub)
 	(_DirectoryMode (set_tile "cur_dwg" _LXCur))

 	(set_tile "out_text" "Browse to Select Output File")
 	(set_tile "xref" _LXref)

 	(_dcList  "pad" '("Space [   ]" "Tab [   	]" "Point [ . ]" "Hyphen [ - ]" "Comma [ , ]" "Semi-Colon [ ; ]"))
 	(set_tile "pad" _LXPad)

 	(foreach x '("pad" "pad_text") (mode_tile x 1))
 	(mode_tile "xml" 1)

 	(_Logo "logo")

 	(
   	(lambda ( i )
     	(mapcar
       	(function
         	(lambda ( tile )
           	(set_tile tile
             	(if (= (setq i (lsh i 1)) (logand _LXBit i)) "1" "0")
           	)
         	)
       	)
       	tiles
     	)
   	)
   	1
 	)

 	(action_tile "dir"
   	(vl-prin1-to-string
     	(quote
       	(progn
         	(if (setq tmp (LM:DirectoryDialog "Select Directory of Drawings to Process..." nil 320))
           	(_DirectoryText "dir_text" (setq _LXDir tmp))
         	)
       	)
     	)
   	)
 	)

 	(action_tile "sub_dir" "(setq _LXSub $value)")

 	(action_tile "cur_dwg" "(_DirectoryMode (setq _LXCur $value))")

 	(action_tile "browse"
   	(vl-prin1-to-string
     	(quote
       	(progn
         	(if (setq tmp (getfiled "Create Output File" "" "txt;csv;xml" 1))
           	(_DirectoryText "out_text" (setq out tmp))
           	(if out
             	(_DirectoryText "out_text" out)
             	(set_tile "out_text" "Browse to Select Output File")
           	)
         	)
         	(if out
           	(cond
             	( (eq ".TXT" (setq ext (strcase (vl-filename-extension out))))

               	(foreach x '("pad" "pad_text") (mode_tile x 0))
               	(mode_tile "xml" 1)
             	)
             	( (eq ".XML" ext)

               	(foreach x '("pad" "pad_text") (mode_tile x 1))
               	(mode_tile "xml" 0)
             	)
             	(t
  				
               	(foreach x '("pad" "pad_text") (mode_tile x 1))
               	(mode_tile "xml" 1)
             	)
           	)
         	)
       	)
     	)
   	)
 	)

 	(action_tile "xref" "(setq _LXref $value)")

 	(action_tile "pad"  "(setq _LXPad $value)")

 	(action_tile "xml"  "(_XMLOptions dc)")

 	(
   	(lambda ( i )
     	(mapcar
       	(function
         	(lambda ( tile )
           	(action_tile tile
             	(strcat "(setq _LXBit ((if (eq \"1\" $value) + -) _LXBit " (itoa (setq i (lsh i 1))) " ))")
           	)
         	)
       	)
       	tiles
     	)
   	)
   	1
 	)

 	(action_tile "accept"
   	(vl-prin1-to-string
     	(quote
       	(progn
         	(cond
           	(
             	(not out)

             	(_Popup "Information" 64 "Please Specify an Output File")
           	)
           	(
             	(not
               	(setq lst
                 	(cond
                   	( (eq "1" _LXCur)
        				
                     	(list
                       	(cond
                         	( (eq "" (vla-get-FullName acdoc))
              				
                           	(strcat (_FixDir (vla-get-Path acdoc)) "\\" (vla-get-name acdoc))
                         	)
                         	( (vla-get-FullName acdoc) )
                       	)
                     	)
                   	)
                   	( (LM:GetAllFiles _LXDir (eq "1" _LXSub) "*.dwg") )
                 	)
               	)
             	)

             	(_Popup "Information" 48 "No Drawing Files Found in the Selected Directory")
           	)
           	( (done_dialog 1) )
         	)
       	)
     	)
   	)
 	)
	
 	(setq df (start_dialog) dc (unload_dialog dc))

 ;............................................................;

 	(if (= 1 df)
   	(progn
     	(setq odbx (LM:ObjectDBXDocument))
		
     	(foreach dwg lst
       	(if
         	(setq doc
           	(cond
             	( (eq "1" _LXCur) acdoc )
             	( (cdr (assoc (strcase dwg) acdocs)) )
             	( (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list odbx dwg)))) odbx )
           	)
         	)
         	(progn
           	(setq data (cons (cons dwg (_GetLayerProperties doc _LXBit (eq "1" _LXref))) data))
           	(princ (strcat "\n--> Extracted: " (vl-filename-base dwg) ".dwg"))
         	)      	
         	(princ (strcat "\n** Error Opening Drawing: " (vl-filename-base dwg) ".dwg"))
       	)
     	)
     	(LM:ReleaseObject odbx)

     	(if (setq data (vl-sort data '(lambda ( a b ) (< (car a) (car B)))) l data)

       	(if (setq ofile (open out "w"))
         	(progn
           	(
             	(lambda ( i )
               	(setq titles
                 	(vl-remove-if-not
                   	(function
                     	(lambda ( title ) 
                       	(= (setq i (if (zerop i) 1 (lsh i 1))) (logand i _LXBit))
                     	)
                   	)
                   	titles
                 	)
               	)
             	)
             	0
           	)

           	(cond
             	(
               	(eq ".TXT" (setq ext (strcase (vl-filename-extension out))))
  				
               	(write-line
                 	(strcat "Layer Extraction: "
                   	(menucmd "m=$(edtime,$(getvar,DATE),DDDD DD MONTH YYYY HH:MM:SS)")
                 	)
                 	ofile
               	)

               	(setq tl titles l (apply 'append (mapcar 'cdr l)) padC (nth (atoi _LXPad) '(32 9 46 45 44 59)))

               	(while (car (setq x (mapcar 'car l)))
                 	(setq ll (cons (+ 5 (apply 'max (mapcar 'strlen (cons (car tl) x)))) ll) tl (cdr tl) l (mapcar 'cdr l))
               	)
               	(setq ll (reverse ll))

               	(foreach x data
                 	(write-line (strcat "\nDrawing File:  " (car x)) ofile)

                 	(foreach item (cons titles (cdr x))
                   	(write-line
                     	(vl-string-right-trim (chr padC)
                       	(apply 'strcat
                         	(mapcar '(lambda ( str len ) (_PadRight str padC len)) item ll)
                       	)
                     	)
                     	ofile
                   	)
                 	)
               	)
             	)
             	(
               	(eq ".CSV" ext)
  				
               	(write-line
                 	(strcat "Layer Extraction:,"
                   	(menucmd "m=$(edtime,$(getvar,DATE),DDDD DD MONTH YYYY HH:MM:SS)")
                 	)
                 	ofile
               	)

               	(foreach x data
                 	(write-line (strcat "\nDrawing File:," (car x)) ofile)

                 	(foreach item (cons titles (cdr x))
                   	(write-line (LM:lst->str item ",") ofile)
                 	)
               	)
             	)
             	(
               	(eq ".XML" ext)

               	(cond
                 	(
                   	(eq "0" _LXL)
                                     	
                   	(setq xtitles (mapcar '(lambda ( title ) (vl-string-translate " " "_" (strcase title t))) titles))
      				
                   	(write-line "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>" ofile)
                   	(if (eq "1" _LXSL)
                     	(write-line (strcat "<?xml-stylesheet type=\"text/xsl\" href=\"" (vl-filename-base out) ".xsl\"?>") ofile)
                   	)       				
                   	(write-line "<extraction>" ofile)

                   	(write-line
                     	(strcat "\t<title>Layer Extraction: "
                       	(menucmd "m=$(edtime,$(getvar,DATE),DDDD DD MONTH YYYY HH:MM:SS)")
                       	"</title>"
                     	)
                     	ofile
                   	)

                   	(foreach x data
                     	(write-line "\t<file>" ofile)
                     	(write-line (strcat "\t\t<filename>" (_ReplaceEntRefs (car x)) "</filename>") ofile)

                     	(foreach item (cdr x) (write-line "\t\t<layer_item>" ofile)                        	
                       	(mapcar
                         	(function
                           	(lambda ( tag value )
                             	(write-line (strcat "\t\t\t<" tag ">" (_ReplaceEntRefs value) "</" tag ">") ofile)
                           	)
                         	)
                         	xtitles item
                       	)
                       	(write-line "\t\t</layer_item>" ofile)
                     	)
                     	(write-line "\t</file>" ofile)
                   	)
                   	(write-line "</extraction>" ofile)

                   	(if (eq "1" _LXSL)
                     	(if (setq sfile (open (strcat (vl-filename-directory out) "\\" (vl-filename-base out) ".xsl") "w"))
                       	(progn
                         	(mapcar
                           	(function
                             	(lambda ( x ) (write-line x sfile))
                           	)
                           	(append
                             	(list
                               	"<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>"
                               	"<xsl:stylesheet version=\"1.0\" xmlns:xsl=\"http://www.w3.org/1999/XSL/Transform\">"
                               	"<xsl:template match=\"/\">"
                               	"<html>"
                               	"\t<head><title>Layer Extraction</title></head>"
                               	"\t<body style=\"font-family:Verdana,Arial;font-size:10pt;background-color:#cccccc;\">"
                               	"\t\t<h3><xsl:value-of select=\"extraction/title\"/></h3>"
                               	"\t\t<table border=\"1\" cellpadding=\"5\" style=\"border-collapse:collapse;border:1px solid navy;\">"
                               	"\t\t\t<xsl:for-each select=\"extraction/file\">"
                               	"\t\t\t\t<tr bgcolor=\"#2e2e2e\">"
                               	"\t\t\t\t<th colspan=\"12\" style=\"text-align:left;color:silver;\"><xsl:value-of select=\"filename\"/></th>"
                               	"\t\t\t\t</tr>"
                               	"\t\t\t\t<tr bgcolor=\"#a8c3f3\">"
                             	)
                             	(mapcar
                               	(function
                                 	(lambda ( title ) (strcat "\t\t\t\t<th>" title "</th>"))
                               	)
                               	titles
                             	)
                             	(list
                               	"\t\t\t\t</tr>"
                               	"\t\t\t\t<xsl:for-each select=\"layer_item\">"
                               	"\t\t\t\t\t<tr>"         				
                               	"\t\t\t\t\t<xsl:choose>"
                               	"\t\t\t\t\t\t<xsl:when test=\"position() mod 2 = 0\">"
                               	"\t\t\t\t\t\t\t<xsl:attribute name=\"bgcolor\">#a8c3f3</xsl:attribute>"
                               	"\t\t\t\t\t\t</xsl:when>"
                               	"\t\t\t\t\t\t<xsl:otherwise>"
                               	"\t\t\t\t\t\t\t<xsl:attribute name=\"bgcolor\">#5c97ff</xsl:attribute>"
                               	"\t\t\t\t\t\t</xsl:otherwise>"
                               	"\t\t\t\t\t</xsl:choose>"
                               	(strcat "\t\t\t\t\t<td style=\"font-weight:bold;\"><xsl:value-of select=\"" (car xtitles) "\"/></td>")
                             	)
                             	(mapcar
                               	(function
                                 	(lambda ( title ) (strcat "\t\t\t\t\t<td><xsl:value-of select=\"" title "\"/></td>"))
                               	)
                               	(cdr xtitles)
                             	)
                             	(list
                               	"\t\t\t\t\t</tr>"
                               	"\t\t\t\t</xsl:for-each>"
                               	"\t\t\t</xsl:for-each>"
                               	"\t\t</table>"
                               	"\t</body>"
                               	"</html>"
                               	"</xsl:template>"
                               	"</xsl:stylesheet>"
                             	)
                           	)
                         	)
                         	(setq sfile (close sfile))
                       	)
                       	(princ "\n** Unable to Create XML StyleSheet (XSL) File **")
                     	)
                   	)
                 	)
                 	(
                   	(eq "1" _LXL)

                   	(foreach x
        				'(
          				"<?xml version=\"1.0\"?>"
          				"<?mso-application progid=\"Excel.Sheet\"?>"
          				"<Workbook"
          				"xmlns=\"urn:schemas-microsoft-com:office:spreadsheet\""
          				"xmlns:o=\"urn:schemas-microsoft-com:office:office\""
          				"xmlns:x=\"urn:schemas-microsoft-com:office:excel\""
          				"xmlns:ss=\"urn:schemas-microsoft-com:office:spreadsheet\""
          				"xmlns:html=\"http://www.w3.org/TR/REC-html40\">"
                     	)
                     	(write-line x ofile)
                   	)

                   	(foreach x data
                     	(write-line (strcat "\t<Worksheet ss:Name=\"" (_ReplaceEntRefs (vl-filename-base (car x))) "\">") ofile)

                     	(write-line
                       	(strcat
                         	"\t\t<Table ss:ExpandedColumnCount=\"" (itoa (length titles)) "\""
                         	" ss:ExpandedRowCount=\"" (itoa (1+ (length (cdr x))))
                         	"\" x:FullColumns=\"1\" x:FullRows=\"1\" ss:DefaultRowHeight=\"15\">"
                       	)
                       	ofile
                     	)
                     	(write-line "\t\t\t<Row>" ofile)
                     	
                     	(foreach title titles
                       	(write-line (strcat "\t\t\t\t<Cell><Data ss:Type=\"String\">" (_ReplaceEntRefs title) "</Data></Cell>") ofile)
                     	)
                     	(write-line "\t\t\t</Row>" ofile)
                     	
                     	(foreach item (cdr x) (write-line "\t\t\t<Row>"  ofile)                        	
                       	(foreach prop item
                         	(write-line
                           	(strcat "\t\t\t\t<Cell><Data ss:Type=\""
                             	(if (numberp (read prop)) "Number" "String") "\">" (_ReplaceEntRefs prop) "</Data></Cell>"
                           	)
                           	ofile
                         	)
                       	)
                       	(write-line "\t\t\t</Row>" ofile)
                     	)                      	
                     	(write-line "\t\t</Table>" ofile)
                     	(write-line "\t</Worksheet>" ofile)
                   	)
                   	(write-line "</Workbook>" ofile)
                 	)
               	)
             	)
           	)

           	(setq ofile (close ofile))
           	(princ "\n-->>> Extraction Complete.")
           	
           	(_WriteConfig cfgfname (mapcar 'eval SymList))
         	)
         	(princ "\n** Error Creating Output File **")
       	)
       	(princ "\n** No Data to Write to Output File **")
     	)
   	)
   	(princ "\n*Cancel*")
 	)
)
 )

 (princ)
)

;;-------------------=={ Directory Dialog }==-----------------;;
;;                                                        	;;
;;  Displays a dialog prompting the user to select a folder   ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com   	;;
;;------------------------------------------------------------;;
;;  Arguments:                                            	;;
;;  msg  - message to display at top of dialog            	;;
;;  dir  - root directory (or nil)                        	;;
;;  flag - bit coded flag specifying dialog display settings  ;;
;;------------------------------------------------------------;;
;;  Returns:  Selected folder filepath, else nil          	;;
;;------------------------------------------------------------;;

(defun LM:DirectoryDialog ( msg dir flag / Shell HWND Fold Self Path ac )

 (setq Shell (vla-getInterfaceObject (setq ac (vlax-get-acad-object)) "Shell.Application")
   	HWND  (vl-catch-all-apply 'vla-get-HWND (list ac))
   	Fold  (vlax-invoke-method Shell 'BrowseForFolder (if (vl-catch-all-error-p HWND) 0 HWND)  msg flag dir))
 (vlax-release-object Shell)
 
 (if Fold
(progn
 	(setq Self (vlax-get-property Fold 'Self) Path (vlax-get-property Self 'Path))
 	(vlax-release-object Self)
 	(vlax-release-object Fold)  	
 	
 	(and (= "\\" (substr Path (strlen Path)))
  		(setq Path (substr Path 1 (1- (strlen Path)))))
)
 )
 Path
)

;;--------------------=={ Get All Files }==-------------------;;
;;                                                        	;;
;;  Retrieves all files or those of a specified filetype that ;;
;;  reside in a directory (and, optionally, subdirectories)   ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com   	;;
;;------------------------------------------------------------;;
;;  Arguments:                                            	;;
;;  Dir  	- Directory to search                        	;;
;;  Subs 	- Boolean, if T, subdirectories are included 	;;
;;  Filetype - (optional) Filter for filetype (DOS pattern)   ;;
;;------------------------------------------------------------;;
;;  Returns:  List of filenames, else nil if none are found   ;;
;;------------------------------------------------------------;;

(defun LM:GetAllFiles ( Dir Subs Filetype / GetSubFolders )
 
 (defun GetSubFolders ( folder / _f )
(mapcar
 	(function
   	(lambda ( f ) (setq _f (strcat folder "\\" f))
     	(cons _f (apply (function append) (GetSubFolders _f)))
   	)
 	)
 	(cddr (vl-directory-files folder nil -1))
)
 )

 (apply (function append)
(vl-remove (quote nil)
 	(mapcar
   	(function
     	(lambda ( Filepath )
       	(mapcar
         	(function
           	(lambda ( Filename )
             	(strcat Filepath "\\" Filename)
           	)
         	)
         	(vl-directory-files Filepath Filetype 1)
       	)
     	)
   	)
   	(append (list Dir) (apply (function append) (if subs (GetSubFolders Dir))))
 	)
)
 )
)

;;-----------------=={ ObjectDBX Document }==-----------------;;
;;                                                        	;;
;;  Retrieves a version specific ObjectDBX Document object	;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com   	;;
;;------------------------------------------------------------;;
;;  Arguments: - None -                       				;;
;;------------------------------------------------------------;;
;;  Returns:  VLA ObjectDBX Document object, else nil 		;;
;;------------------------------------------------------------;;

(defun LM:ObjectDBXDocument ( / acVer )
 (vla-GetInterfaceObject (vlax-get-acad-object)
(if (< (setq acVer (atoi (getvar "ACADVER"))) 16)
 	"ObjectDBX.AxDbDocument"
 	(strcat "ObjectDBX.AxDbDocument." (itoa acVer))
)
 )
)

;;------------------=={ Release Object }==--------------------;;
;;                                                        	;;
;;  Releases a VLA Object from memory via plentiful error 	;;
;;  trapping                                              	;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com   	;;
;;------------------------------------------------------------;;
;;  Arguments:                                            	;;
;;  obj - VLA Object to be released from memory   			;;
;;------------------------------------------------------------;;
;;  Returns:  T if Object Released, else nil              	;;
;;------------------------------------------------------------;;

(defun LM:ReleaseObject ( obj ) (vl-load-com)
 (and obj (eq 'VLA-OBJECT (type obj)) (not (vlax-object-released-p obj))
(not
 	(vl-catch-all-error-p
   	(vl-catch-all-apply
     	(function vlax-release-object) (list obj)
   	)
 	)
)
 )
)

;;-------------------=={ List to String }==-------------------;;
;;                                                        	;;
;;  Constructs a string from a list of strings separating 	;;
;;  each element by a specified delimiter     				;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com   	;;
;;------------------------------------------------------------;;
;;  Arguments:                                            	;;
;;  lst - a list of strings to process                    	;;
;;  del - delimiter by which to separate each list element	;;
;;------------------------------------------------------------;;
;;  Returns:  String containing each string in the list   	;;
;;------------------------------------------------------------;;

(defun LM:lst->str ( lst del )
 (if (cdr lst)
(strcat (car lst) del (LM:lst->str (cdr lst) del))
(car lst)
 )
)

;;------------------------------------------------------------;;

(princ)
(princ "\n:: Layer Extractor | Version 1.4 | © Lee Mac 2011 www.lee-mac.com ::")
(princ "\n:: Type \"LayerExtract\" or \"LX\" to Invoke ::")
(princ)

;;------------------------------------------------------------;;
;;         				End of File                    	;;
;;------------------------------------------------------------;;

 

Olivier

Lien vers le commentaire
Partager sur d’autres sites
lili2006 Community Regular

lili2006

Posté(e)
Posté(e)

Bonjour à toutes et tous,

 

Une erreur également chez moi =>

 

Commande: LX

--> Extracted: Plan parcelle M CAUCHELIN.dwg

** Error: type d'argument incorrect: stringp nil **

Commande:

 

Et le rapport ne contient que =>

Layer Extraction: Lundi 19 Janvier 2015 15:15:55

Civil 3D 2024 - COVADIS_18.2

https://www.linkedin...3%ABt-95313341/

Lien vers le commentaire
Partager sur d’autres sites
fauxsuisse Newbie

fauxsuisse

Posté(e)
Posté(e)

Bonjour,

 

Fonctionne chez moi sur mon MAP 2012 et Excel 2007.

Où voit-on l'export XLS, moi je n'ai que TXT, CSV et XML?

 

Olivier

 

effectivement c'est XML, moi je suis MEP 2015 et Excel 2013

en format XSL il fonctionne mais je n'ai pas la colonne transparence, et quand je lance le programme sur le menu des cases à cocher je n'ai pas non plus celle des transparence

Lien vers le commentaire
Partager sur d’autres sites
fauxsuisse Newbie

fauxsuisse

Posté(e)
Posté(e)

Re,

 

As tu vidé ton cache (Si tu as utilisé la version avant modifs par Olivier) ?

 

Car moi, j'ai bien cette option en haut à gauche de la BD,..

 

J'ai vidé tous mes répertoire temporaire redémarré Windows mais j'ai toujours la même fenêtre, de quel cache parles tu ?

Effectivement si je regarde dans le lisp le paramètre transparency

Lien vers le commentaire
Partager sur d’autres sites
Invité
Répondre à ce sujet…

×   Collé en tant que texte enrichi.   Coller en tant que texte brut à la place

  Seulement 75 émoticônes maximum sont autorisées.

×   Votre lien a été automatiquement intégré.   Afficher plutôt comme un lien

×   Votre contenu précédent a été rétabli.   Vider l’éditeur

×   Vous ne pouvez pas directement coller des images. Envoyez-les depuis votre ordinateur ou insérez-les depuis une URL.

×
 Partager
Aller sur la liste des sujets
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité