Exporter/importer des filtres de calque

(gile) · le 18 octobre 2008

Salut,

D'une rencontre (réelle) avec deux membres de CADxp (lecrabe et phil_vsd), est née l'idée d'une routine qui permettrait l'exportation et l'importation de filtres de propriétés de calques par le biais de fichiers externes.

Les données de chaque filtre sont enregistrées dans un fichier texte (extension .flt).

On peut donc se créer, dans un dossier, une "bibliothèque" avec les filtres couramment utilisés.

Comme d'habitude, je laisse le code ici en phase de tests (merci d'avance aux testeurs) avant de le mettre en télé chargement.

EDIT 1 : nouvelle version (possibilité d'importer directement depuis un dwg ou un dwt)

EDIT 2 : ajout de contrôles au cas où le dessin source ne contienne pas de filtre.

;; EXPFLTR & IMPFLTR (gile)
;; Exporter et importer des filtres de propriété de calque

;; EXPFLTR
;; Exporte les données d'un filtre de calque du dessin courant dans un fichier (.flt)

(defun c:ExpFltr (/		layerDict     layerFilters
	  filterList	filterName    layerFilter
	  dataType	dataValue     filterDatas
	  fileName	file
	 )
 (vl-load-com)
 (or *acdoc*
     (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
 )
 (if
   (and
     (setq layerDict
     (vla-getExtensionDictionary (vla-get-Layers *acdoc*))
     )
     (setq layerFilters (GetItem layerDict "ACAD_LAYERFILTERS"))
     (vlax-for	f layerFilters
(setq filterList (cons (vla-get-Name f) filterList))
     )
   )
    (if (setq filterName
	(ListBox "Exporter un filtre de propriété"
		 "Choisir le filtre à exporter"
		 (mapcar '(lambda (x) (cons x x))
			 (reverse filterList)
		 )
		 0
	)
 )
      (if
 (setq
   fileName (getfiled "Créer un fichier d'exportation"
		      filterName
		      "lft"
		      1
	    )
 )
  (progn
    (setq file (open fileName "w"))
    (write-line
      "//Fichier d'exportation de filtre de calque, NE PAS MODIFIER."
      file
    )
    (mapcar
      (function
	(lambda (x) (write-line (vl-prin1-to-string x) file))
      )
      (getFilterDatas *acdoc* filterName)
    )
    (close file)
  )
      )
    )
    (alert "Aucun filtre de propriété de calque dans le dessin")
 )
 (princ)
)

;; IMPFLTR
;; Importe un filtre de calque dans le dessin courant depuis un fichier d'exportation (.flt)
;; ou depuis un dessin (.dwg) ou un gabarit (dwt)

(defun c:ImpFltr (/	       fileName	    file	 dataList
	  filterName   source	    odbx	 layerDict
	  layerFilters filterList
	 )
 (vl-load-com)
 (or *acdoc*
     (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
 )
 (if (setq fileName (getfiled "Importer un filtre" "" "lft;dwg;dwt" 0))
   (cond
     ((= (strcase (vl-filename-extension fileName)) ".LFT")
      (setq file (open fileName "r"))
      (read-line file)
      (repeat 4
 (setq dataList (cons (read (read-line file)) dataList))
      )
      (close file)
      (setq dataList	(reverse dataList)
     filterName	(caadr dataList)
      )
      (if (not (addLayerFilter *acdoc* dataList))
 (alert
   (strcat "\nLe filtre \"" filterName "\" existe déjà.")
 )
      )
     )
     ((member (strcase (vl-filename-extension fileName))
       '(".DWG" ".DWT")
      )
      (if
 (not
   (and
     (setq
       source (GetItem
		(vla-get-Documents (vlax-get-acad-object))
		(strcat (vl-filename-base fileName) ".dwg")
	      )
     )
     (= fileName (vla-get-FullName source))
   )
 )
  (setq	source (OpenDrawingDBX filename)
	odbx   T
  )
      )
      (if
 (and
   (setq layerDict (vla-getExtensionDictionary
		     (vla-get-Layers source)
		   )
   )
   (setq layerFilters (GetItem layerDict "ACAD_LAYERFILTERS"))
   (vlax-for f layerFilters
     (setq filterList (cons (vla-get-Name f) filterList))
   )
 )
  (if (setq filterName
	     (ListBox
	       "Importer un filtre de propriété"
	       "Choisir le filtre à importer"
	       (mapcar '(lambda (x) (cons x x)) (reverse filterList))
	       0
	     )
      )
    (if	(not (addLayerFilter
	       *acdoc*
	       (getFilterDatas source filterName)
	     )
	)
      (alert
	(strcat "\nLe filtre \"" filterName "\" existe déjà.")
      )
    )
  )
  (alert
    "Aucun filtre de propriété de calque dans le dessin source"
  )
      )
      (and odbx (vlax-release-object source))
     )
     (T (alert "Le fichier choisi n'est pas valide."))
   )
 )
 (princ)
)

;;===========================================================;;

;; getFilterDatas (gile)
;; Récupère les données d'un filtre de propriété de calque
;;
;; Arguments
;; sourceDoc : le document dans lequel est récupéré le filtre (vla-object)
;; filterName : le nom du filtre de calque (string)
;;
;; Retour
;; une liste de 4 sous-listes contenant les données des XRecords du filtre
;; ou nil si le filtre nommé n'existe pas dans le document.

(defun getFilterDatas (sourceDoc     filterName	   /
	       layerDict     layerFilters  aclyDict
	       layerFilter   dataType	   dataValue
	       tmpType	     tmpValue	   return
	      )

 (setq
   layerDict (vla-getExtensionDictionary (vla-get-Layers sourceDoc))
 )
 (if
   (and
     (setq layerFilters (GetItem layerDict "ACAD_LAYERFILTERS"))
     (setq aclyDict (GetItem layerDict "ACLYDICTIONARY"))
     (setq layerFilter (GetItem layerFilters filterName))
   )
    (progn
      (vlax-for xr aclyDict
 (vla-GetXRecordData xr 'dataType 'dataValue)
 (setq tmpType (vlax-safearray->list dataType))
 (if (= 290 (car tmpType))
   (setq tmpValue (mapcar 'vlax-variant-value
			  (cdr (vlax-safearray->list dataValue))
		  )
	 tmpType  (cdr tmpType)
   )
   (setq tmpValue (mapcar 'vlax-variant-value
			  (vlax-safearray->list dataValue)
		  )
   )
 )
 (if (and (= (car tmpValue) "AcLyLayerFilter")
	  (member filterName tmpValue)
     )
   (setq return (list tmpType tmpValue))
 )
      )
      (vla-GetXRecordData layerFilter 'dataType 'dataValue)
      (setq
 return	(cons (vlax-safearray->list dataType)
	      (cons (mapcar 'vlax-variant-value
			    (vlax-safearray->list dataValue)
		    )
		    return
	      )
	)
      )
    )
 )
)

;;===========================================================;;

;; addLayerFilter (gile)
;; Ajoute un filtre de propriétés de calque au document
;;
;; Arguments
;; targetDoc : le document cible (vla-object)
;; dataList : une liste de 4 sous-listes contenant les données des XRecords du filtre
;;
;; Retour : T ou nil si le filtre est déjà présent dans le document

(defun addLayerFilter (targetDoc    dataList	 /
	       filterName   layerDict	 layerFilters
	       aclyDict	    layerFilter	 n
	       aclyName	    aclyXRec
	      )

 (setq	filterName (caadr dataList)
layerDict  (vla-getExtensionDictionary (vla-get-Layers targetDoc))
 )
 (or
   (setq layerFilters (GetItem layerDict "ACAD_LAYERFILTERS"))
   (and
     (vla-addObject
layerDict
"ACAD_LAYERFILTERS"
"AcDbDictionary"
     )
     (setq layerFilters (vla-item layerDict "ACAD_LAYERFILTERS"))
   )
 )
 (or
   (setq aclyDict (GetItem layerDict "ACLYDICTIONARY"))
   (and
     (vla-addObject layerDict "ACLYDICTIONARY" "AcDbDictionary")
     (setq aclyDict (vla-item layerDict "ACLYDICTIONARY"))
   )
 )
 (if (not (GetItem layerFilters filterName))
   (progn
     (setq layerFilter
     (vla-addXRecord layerFilters filterName)
     )
     (setq n 1)
     (not
(while
  (getitem aclyDict
	   (setq aclyName (strcat "*A" (itoa n)))
  )
   (setq n (1+ n))
)
     )
     (setq aclyXRec (vla-addXRecord aclyDict aclyName))
     (vla-SetXRecordData
layerFilter
(vlax-make-variant
  (vlax-safearray-fill
    (vlax-make-safearray
      vlax-vbInteger
      (cons 0 (1- (length (car dataList))))
    )
    (car dataList)
  )
)
(vlax-make-variant
  (vlax-safearray-fill
    (vlax-make-safearray
      vlax-vbVariant
      (cons 0 (1- (length (cadr dataList))))
    )
    (mapcar 'vlax-make-variant (cadr dataList))
  )
)
     )
     (vla-SetXRecordData
aclyXRec
(vlax-make-variant
  (vlax-safearray-fill
    (vlax-make-safearray
      vlax-vbInteger
      (cons 0 (1- (length (caddr dataList))))
    )
    (caddr dataList)
  )
)
(vlax-make-variant
  (vlax-safearray-fill
    (vlax-make-safearray
      vlax-vbVariant
      (cons 0 (1- (length (cadddr dataList))))
    )
    (mapcar 'vlax-make-variant (cadddr dataList))
  )
)
     )
     T
   )
 )
)

;;===========================================================;;

;; ListBox (gile)
;; Boite de dialogue permettant un ou plusieurs choix dans une liste
;;
;; Arguments
;; title : le titre de la boite de dialogue (chaîne)
;; msg ; message (chaîne), "" ou nil pour aucun
;; keylab : une liste d'association du type ((key1 . label1) (key2 . label2) ...)
;; flag : 0 = liste déroulante
;;        1 = liste choix unique
;;        2 = liste choix multipes
;;
;; Retour : la clé de l'option (flag = 0 ou 1) ou la liste des clés des options (flag = 2)
;;
;; Exemple d'utilisation
;; (listbox "Présentation" "Choisir une présentation" (layoutlist) 1)

(defun ListBox (title msg keylab flag / tmp file dcl_id choice)
 (setq	tmp  (vl-filename-mktemp "tmp.dcl")
file (open tmp "w")
 )
 (write-line
   (strcat "ListBox:dialog{label=\"" title "\";")
   file
 )
 (if (and msg (/= msg ""))
   (write-line (strcat ":text{label=\"" msg "\";}") file)
 )
 (write-line
   (cond
     ((= 0 flag) "spacer;:popup_list{key=\"lst\";")
     ((= 1 flag) "spacer;:list_box{key=\"lst\";")
     (T "spacer;:list_box{key=\"lst\";multiple_select=true;")
   )
   file
 )
 (write-line "}spacer;ok_cancel;}" file)
 (close file)
 (setq dcl_id (load_dialog tmp))
 (if (not (new_dialog "ListBox" dcl_id))
   (exit)
 )
 (start_list "lst")
 (mapcar 'add_list (mapcar 'cdr keylab))
 (end_list)
 (action_tile
   "accept"
   "(or (= (get_tile \"lst\") \"\")
   (if (= 2 flag) (progn
   (foreach n (str2lst (get_tile \"lst\") \" \")
   (setq choice (cons (nth (atoi n) (mapcar 'car keylab)) choice)))
   (setq choice (reverse choice)))
   (setq choice (nth (atoi (get_tile \"lst\")) (mapcar 'car keylab)))))
   (done_dialog)"
 )
 (start_dialog)
 (unload_dialog dcl_id)
 (vl-file-delete tmp)
 choice
)

;;===========================================================;;

;;; GetItem (gile)
;;; Retourne le vla-object de l'item s'il est présent dans la collection
;;;
;;; Arguments
;;; col : la collection (vla-object)
;;; name : le nom de l'objet (string) ou son indice (entier)
;;;
;;; Retour : le vla-object ou nil

(defun GetItem (col name / obj)
 (vl-catch-all-apply
   (function (lambda () (setq obj (vla-item col name))))
 )
 obj
)

;;===========================================================;;

;; OpenDrawingDBX (Patrick_35 ?)
;; Accéder à un dessin fermé
;;
;; Argument : le chemin complet du fichier (dwg)
;;
;; Retour : le document (vla-object)

(defun OpenDrawingDBX (dwg / odbx)
 (if
   (     (setq odbx (vlax-create-object "ObjectDBX.AxDbDocument"))
    (setq odbx	(vlax-create-object
	  (strcat "ObjectDBX.AxDbDocument."
		  (substr (getvar "ACADVER") 1 2)
	  )
	)
    )
 )
 (vla-open odbx dwg)
 odbx
)

[Edité le 19/10/2008 par (gile)][Edité le 20/10/2008 par (gile)]

(gile) · le 19 octobre 2008

Re,

J'ai ajouté à IMPFLTR la possibilité d'importer un filtre depuis un fichier dwg (ouvert et non actif ou fermé).

lili2006 · le 19 octobre 2008

Bonsoir à toutes et tous,

J'ai fait un test vite fait sur un fichier, mais "ExpFltr " ne trouve que 1 filtre de propriété sur les 4 ?

Peut-être m'y prend-je mal ?

Quand à "ImpFltr " ,j''ai ce message :

Commande:
Commande: ExpFltr
; erreur: Erreur Automation Clé introuvable
Commande:

En tous cas, encore une super idée,...:D

Je dois reconnaitre que je n'ai pas vraiment d'occasion de m'en servir,...

Voila de mon coté pour une V2008 pleine (pas eu encore le temps de tester sur une V2009 MAP 3D,...)

lovecraft · le 19 octobre 2008

Bonsoir,

Voila je viens de tester pour toi "lili2006" la routine sur la version MAP 2009, aucun soucis l'export fonctionne et l'import aussi.

C'est une très bonne idée que vous avez eu de faire ce genre de routine.Je pense qu'elle va servir à un grand nombres de personnes qui aime l'organisation.

@plus

LB

PS: "Encore du grand Gile ou (Gile) ;)

(gile) · le 20 octobre 2008

Merci aux premiers testeurs.

J'ai fait un test vite fait sur un fichier, mais "ExpFltr " ne trouve que 1 filtre de propriété sur les 4 ?

Curieux, les filtres sont ils bien des filtres de propriété (pas des filtres de groupe) ? as-tu essayé de "dérouler" la liste dan la boite de dialogue "Choisir le filtre à exporter" ?

Quand à "ImpFltr " ,j''ai ce message :

citation extraite du message original:
Commande:
Commande: ExpFltr
; erreur: Erreur Automation Clé introuvable
Commande:

Tu as du lancé EXPFLTR (au lieu de IMPFLTR) dans un dessin ne comportant pas de filtre de calque.

Je modifie le code pour corriger ça.

lili2006 · le 20 octobre 2008

Bonjour à toutes et tous,

Curieux, les filtres sont ils bien des filtres de propriété (pas des filtres de groupe) ? as-tu essayé de "dérouler" la liste dan la boite de dialogue "Choisir le filtre à exporter" ?

Ben oui ! Enfin, il me semble que les autres filtres sont corrects ! Dans la BD, je n'ai que le filtre "NON IMPRIMABLE" qui est reconnue,

As-tu testé mon fichier joint réponse précédente ?

Tu as du lancé EXPFLTR (au lieu de IMPFLTR)

Possible, puisqu'en retestant ce matin, j'ai pu récupérer le fichier "NON IMPRIMABLE.lft" sans problème sur un nouveau fichier ayant le même jeu de calques,....

A priori, lovecraft valide le bon fonctionnement,

Cela doit venir de moi alors,... ;)

Merci encore,

lili2006 · le 20 octobre 2008

Re,

Second test ici, même constat !

bseb67 · le 20 octobre 2008

Salut!

Bon travail (gile) :D ,

chez moi ca marche nickel sur ma mep2008 en full pour l'utilisation que l'on fait des filtres.

Mais pour les sous-filtres ca ne marche pas.

par contre il y aurai quelques points à modifier:

- pouvoir exporter tous les filtres en une fois et donc les importer en une fois aussi

- sauvegarder le chemin d'enregistrement plutot que de repartir sur "mes documents"

- mettre le filtre lft en route pour les fichiers dans ImpFltr, au pire laisser un *.* et mettre un *.lft en plus en deuxième choix de filtre.

Voilà.

sbosarl · le 20 octobre 2008

bonjour,

effectivement si sur les filtres tu met une info d'etat il n'apparaisse pas

dans le deroulant

(gile) · le 20 octobre 2008

lili2006,

J'ai regardé ton fichier, si tu ouvres le gestionnaire des calques, seul le filtre "NON IMPRIMABLE" semble fonctionner les autres n'affichent aucun calque (alors qu'il devraient au vu des propriétés) ???...

Ces filtres n'ont aucune entrée dans le dictionnaire où sont stockés les filtres de propriété, c'est pour ça qu'ils ne s'affichent pas dans la BD "Choisir le filtre à exporter".

lili2006 · le 20 octobre 2008

Re,

Ces filtres n'ont aucune entrée dans le dictionnaire où sont stockés les filtres de propriété, c'est pour ça qu'ils ne s'affichent pas dans la BD "Choisir le filtre à exporter".

Et c'est grave Doc ou normal ?

Merci d'avoir jeté un oeil, :P

(gile) · le 20 octobre 2008

Salut lili2006,

Non ce n'est pas normal sans pour autant être "grave".

Ces filtres ne sont pas valides et je ne sais pourquoi, essaye de les refaire et de les exporter ensuite.

lili2006 · le 20 octobre 2008

Re,

Merci encore (gile),

Je pense qu'il y a un lien direct avec ce problème,...

(gile) · le 4 novembre 2008

Salut,

Pour essayer de répondre à la demande bseb67, voilà une nouvelle version (beta) qui permet d'exporter et d'importer plusieurs filtres.

L'importation multiple ne fonctionne que sous certaines conditions :

- AutoCAD 2007 ou plus

- La présence de GetFilesLisp.dll dans un répertoire du chemin de recherche d'AutoCAD sur le poste local (le lancement d'une DLL depuis un serveur peut nécessiter une modification des "permissions" voir ici).

;; EXPFLTR & IMPFLTR (gile) version 2 (beta)
;; Exporter et importer des filtres de propriété de calque

;; EXPFLTR
;; Exporte les données d'un filtre de calque du dessin courant dans un fichier (.flt)

(defun c:ExpFltr (/		layerDict     layerFilters
	  filterList	filterName direct   layerFilter
	  dataType	dataValue     filterDatas
	  fileName	file
	 )
 (vl-load-com)
 (or *acdoc*
     (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
 )
 (if
   (and
     (setq layerDict
     (vla-getExtensionDictionary (vla-get-Layers *acdoc*))
     )
     (setq layerFilters (GetItem layerDict "ACAD_LAYERFILTERS"))
     (vlax-for	f layerFilters
(setq filterList (cons (vla-get-Name f) filterList))
     )
   )
    (if (setq filterName
	(ListBox "Exporter des filtres de propriété"
		 "Choisir les filtres à exporter"
		 (mapcar '(lambda (x) (cons x x))
			 (reverse filterList)
		 )
		 2
	)
 )
      (if
 (setq direct
	(DirBox "Choisir ou créer un dossier d'exportation" "" 0)
 )
 (progn
   (foreach f filterName
     (setq fileName (strcat direct "\\" f ".lft"))
     (if
       (or
	 (not (findfile fileName))
	 (and
	   (not (initget "Oui Non"))
	   (/=
	     "Non"
	     (getkword
	       (strcat
		 "\nLe fichier \""
		 f
		 ".lft\" existe déjà, voulez vous l'écraser [Oui/Non] ? : "
	       )
	     )
	   )
	 )
       )
	(progn
	  (setq file (open fileName "w"))
	  (write-line
	    "//Fichier d'exportation de filtre de calque, NE PAS MODIFIER."
	    file
	  )
	  (mapcar
	    (function
	      (lambda (x)
		(write-line (vl-prin1-to-string x) file)
	      )
	    )
	    (getFilterDatas *acdoc* f)
	  )
	  (close file)
	)
     )
   )
   (setenv "LayerFilterDirectory" direct)
 )
      )
    )
    (alert "Aucun filtre de propriété de calque dans le dessin")
 )
 (princ)
)

;; IMPFLTR
;; Importe un filtre de calque dans le dessin courant depuis un fichier d'exportation (.flt)
;; ou depuis un dessin (.dwg) ou un gabarit (dwt)

(defun c:ImpFltr (/	      mult	  fileName    file
	  dataList    filterName  source      odbx
	  layerDict   layerFilters	      filterList
	 )
 (vl-load-com)
 (or *acdoc*
     (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
 )
 (or (getenv "LayerFilterDirectory")
     (setenv "LayerFilterDirectory" (getvar "DWGPREFIX"))
 )
 (or (and getfiles (setq mult T))
     (and (	   (vl-cmdf "_.netload" (findfile "GetFileLisp.dll"))
   (setq mult T)
     )
 )
 (setq	fileName
 (if mult
   (getfiles
     (getenv "LayerFilterDirectory")
     "Filtre (*.lft)|*.lft|Dessin (*.dwg)|*.dwg|Gabarit (*.dwt)|*.dwt"
     T
   )
   (getfiled "Importer un filtre" "" "lft;dwg;dwt" 0)
 )
 )
 (if
   (and fileName
 (or mult (setq filName (list fileName)))
   )
   (progn
    (foreach f	fileName
      (cond
 ((= (strcase (vl-filename-extension f)) ".LFT")
  (setq	file	 (open f "r")
	dataList nil
  )
  (read-line file)
  (repeat 4
    (setq dataList (cons (read (read-line file)) dataList))
  )
  (close file)
  (setq	dataList   (reverse dataList)
	filterName (caadr dataList)
  )
  (if (not (addLayerFilter *acdoc* dataList))
    (alert
      (strcat "\nLe filtre \"" filterName "\" existe déjà.")
    )
  )
 )
 ((member (strcase (vl-filename-extension f))
	  '(".DWG" ".DWT")
  )
  (if
    (not
      (and
	(setq
	  source (GetItem
		   (vla-get-Documents (vlax-get-acad-object))
		   (strcat (vl-filename-base f) ".dwg")
		 )
	)
	(= f (vla-get-FullName source))
      )
    )
     (setq source (OpenDrawingDBX f)
	   odbx	  T
     )
  )
  (if
    (and
      (setq layerDict (vla-getExtensionDictionary
			(vla-get-Layers source)
		      )
      )
      (setq filterList nil
	    layerFilters (GetItem layerDict "ACAD_LAYERFILTERS")
	    )
      (vlax-for	f layerFilters
	(setq filterList (cons (vla-get-Name f) filterList))
      )
    )
     (if (setq filterName
		(ListBox
		  "Importer des filtres de propriété"
		  "Choisir les filtres à importer"
		  (mapcar '(lambda (x) (cons x x)) (reverse filterList))
		  2
		)
	 )
       (foreach	f filterName
	 (if (not (addLayerFilter
		    *acdoc*
		    (getFilterDatas source f)
		  )
	     )
	   (alert
	     (strcat "\nLe filtre \"" f "\" existe déjà.")
	   )
	 )
       )
     )
     (alert
       "Aucun filtre de propriété de calque dans le dessin source"
     )
  )
  (and odbx (vlax-release-object source))
 )
 (T (alert "Le fichier choisi n'est pas valide."))
      )
    )
  (setenv "LayerFilterDirectory" (vl-filename-directory (car filename)))
    )
 )
 (princ)
)

;;===========================================================;;

;; getFilterDatas (gile)
;; Récupère les données d'un filtre de propriété de calque
;;
;; Arguments
;; sourceDoc : le document dans lequel est récupéré le filtre (vla-object)
;; filterName : le nom du filtre de calque (string)
;;
;; Retour
;; une liste de 4 sous-listes contenant les données des XRecords du filtre
;; ou nil si le filtre nommé n'existe pas dans le document.

(defun getFilterDatas (sourceDoc     filterName	   /
	       layerDict     layerFilters  aclyDict
	       layerFilter   dataType	   dataValue
	       tmpType	     tmpValue	   return
	      )

 (setq
   layerDict (vla-getExtensionDictionary (vla-get-Layers sourceDoc))
 )
 (if
   (and
     (setq layerFilters (GetItem layerDict "ACAD_LAYERFILTERS"))
     (setq aclyDict (GetItem layerDict "ACLYDICTIONARY"))
     (setq layerFilter (GetItem layerFilters filterName))
   )
    (progn
      (vlax-for xr aclyDict
 (vla-GetXRecordData xr 'dataType 'dataValue)
 (setq tmpType (vlax-safearray->list dataType))
 (if (= 290 (car tmpType))
   (setq tmpValue (mapcar 'vlax-variant-value
			  (cdr (vlax-safearray->list dataValue))
		  )
	 tmpType  (cdr tmpType)
   )
   (setq tmpValue (mapcar 'vlax-variant-value
			  (vlax-safearray->list dataValue)
		  )
   )
 )
 (if (and (= (car tmpValue) "AcLyLayerFilter")
	  (member filterName tmpValue)
     )
   (setq return (list tmpType tmpValue))
 )
      )
      (vla-GetXRecordData layerFilter 'dataType 'dataValue)
      (setq
 return	(cons (vlax-safearray->list dataType)
	      (cons (mapcar 'vlax-variant-value
			    (vlax-safearray->list dataValue)
		    )
		    return
	      )
	)
      )
    )
 )
)

;;===========================================================;;

;; addLayerFilter (gile)
;; Ajoute un filtre de propriétés de calque au document
;;
;; Arguments
;; targetDoc : le document cible (vla-object)
;; dataList : une liste de 4 sous-listes contenant les données des XRecords du filtre
;;
;; Retour : T ou nil si le filtre est déjà présent dans le document

(defun addLayerFilter (targetDoc    dataList	 /
	       filterName   layerDict	 layerFilters
	       aclyDict	    layerFilter	 n
	       aclyName	    aclyXRec
	      )

 (setq	filterName (caadr dataList)
layerDict  (vla-getExtensionDictionary (vla-get-Layers targetDoc))
 )
 (or
   (setq layerFilters (GetItem layerDict "ACAD_LAYERFILTERS"))
   (and
     (vla-addObject
layerDict
"ACAD_LAYERFILTERS"
"AcDbDictionary"
     )
     (setq layerFilters (vla-item layerDict "ACAD_LAYERFILTERS"))
   )
 )
 (or
   (setq aclyDict (GetItem layerDict "ACLYDICTIONARY"))
   (and
     (vla-addObject layerDict "ACLYDICTIONARY" "AcDbDictionary")
     (setq aclyDict (vla-item layerDict "ACLYDICTIONARY"))
   )
 )
 (if (not (GetItem layerFilters filterName))
   (progn
     (setq layerFilter
     (vla-addXRecord layerFilters filterName)
     )
     (setq n 1)
     (not
(while
  (getitem aclyDict
	   (setq aclyName (strcat "*A" (itoa n)))
  )
   (setq n (1+ n))
)
     )
     (setq aclyXRec (vla-addXRecord aclyDict aclyName))
     (vla-SetXRecordData
layerFilter
(vlax-make-variant
  (vlax-safearray-fill
    (vlax-make-safearray
      vlax-vbInteger
      (cons 0 (1- (length (car dataList))))
    )
    (car dataList)
  )
)
(vlax-make-variant
  (vlax-safearray-fill
    (vlax-make-safearray
      vlax-vbVariant
      (cons 0 (1- (length (cadr dataList))))
    )
    (mapcar 'vlax-make-variant (cadr dataList))
  )
)
     )
     (vla-SetXRecordData
aclyXRec
(vlax-make-variant
  (vlax-safearray-fill
    (vlax-make-safearray
      vlax-vbInteger
      (cons 0 (1- (length (caddr dataList))))
    )
    (caddr dataList)
  )
)
(vlax-make-variant
  (vlax-safearray-fill
    (vlax-make-safearray
      vlax-vbVariant
      (cons 0 (1- (length (cadddr dataList))))
    )
    (mapcar 'vlax-make-variant (cadddr dataList))
  )
)
     )
     T
   )
 )
)

;;===========================================================;;

;; ListBox (gile)
;; Boite de dialogue permettant un ou plusieurs choix dans une liste
;;
;; Arguments
;; title : le titre de la boite de dialogue (chaîne)
;; msg ; message (chaîne), "" ou nil pour aucun
;; keylab : une liste d'association du type ((key1 . label1) (key2 . label2) ...)
;; flag : 0 = liste déroulante
;;        1 = liste choix unique
;;        2 = liste choix multipes
;;
;; Retour : la clé de l'option (flag = 0 ou 1) ou la liste des clés des options (flag = 2)
;;
;; Exemple d'utilisation
;; (listbox "Présentation" "Choisir une présentation" (layoutlist) 1)

(defun ListBox (title msg keylab flag / tmp file dcl_id choice)
 (setq	tmp  (vl-filename-mktemp "tmp.dcl")
file (open tmp "w")
 )
 (write-line
   (strcat "ListBox:dialog{label=\"" title "\";")
   file
 )
 (if (and msg (/= msg ""))
   (write-line (strcat ":text{label=\"" msg "\";}") file)
 )
 (write-line
   (cond
     ((= 0 flag) "spacer;:popup_list{key=\"lst\";")
     ((= 1 flag) "spacer;:list_box{key=\"lst\";")
     (T "spacer;:list_box{key=\"lst\";multiple_select=true;")
   )
   file
 )
 (write-line "}spacer;ok_cancel;}" file)
 (close file)
 (setq dcl_id (load_dialog tmp))
 (if (not (new_dialog "ListBox" dcl_id))
   (exit)
 )
 (start_list "lst")
 (mapcar 'add_list (mapcar 'cdr keylab))
 (end_list)
 (action_tile
   "accept"
   "(or (= (get_tile \"lst\") \"\")
   (if (= 2 flag) (progn
   (foreach n (str2lst (get_tile \"lst\") \" \")
   (setq choice (cons (nth (atoi n) (mapcar 'car keylab)) choice)))
   (setq choice (reverse choice)))
   (setq choice (nth (atoi (get_tile \"lst\")) (mapcar 'car keylab)))))
   (done_dialog)"
 )
 (start_dialog)
 (unload_dialog dcl_id)
 (vl-file-delete tmp)
 choice
)

;;===========================================================;;

;;; GetItem (gile)
;;; Retourne le vla-object de l'item s'il est présent dans la collection
;;;
;;; Arguments
;;; col : la collection (vla-object)
;;; name : le nom de l'objet (string) ou son indice (entier)
;;;
;;; Retour : le vla-object ou nil

(defun GetItem (col name / obj)
 (vl-catch-all-apply
   (function (lambda () (setq obj (vla-item col name))))
 )
 obj
)

;;===========================================================;;

;; OpenDrawingDBX (d'après Patrick_35)
;; Accéder à un dessin fermé
;;
;; Argument : le chemin complet du fichier (dwg)
;;
;; Retour : le document (vla-object)

(defun OpenDrawingDBX (fileName / objDBX)
 ((lambda (release)
    (setq objDBX
    (vlax-create-object
      (if (		"ObjectDBX.AxDbDocument"
	(strcat "ObjectDBX.AxDbDocument." (itoa release))
      )
    )
    )
  )
   (atoi (getvar "ACADVER"))
 )
 (vla-open objDBX fileName)
 objDBX
)

;;; DirBox -Patrick_35-

(defun DirBox (Message Chemin Drapeau / rep sh)
 (setq sh (vlax-create-object "Shell.Application"))
 (if (setq
rep (vlax-invoke sh 'browseforfolder 0 Message Drapeau Chemin)
     )
   (setq rep (vlax-get-property (vlax-get-property rep 'self) 'path))
   (setq rep nil)
 )
 (vlax-release-object sh)
 rep
)

;; str2lst
;; Transforme un chaine avec séparateur en liste de chaines
;;
;; Arguments
;; str : la chaine à transformer en liste
;; sep : le séparateur

(defun str2lst (str sep / pos)
 (if (setq pos (vl-string-search sep str))
   (cons (substr str 1 pos)
  (str2lst (substr str (+ (strlen sep) pos 1)) sep)
   )
   (list str)
 )
)

La Lozère · le 18 décembre 2008

Bonjour,

Super idée cette routine, c'est pile poil ce que l'on cherché avec une collègue. Mais il doit y avoir un truc que j'ai mal fait car j'ai mis les deux fichiers (lsp et dll) sur mon bureau avec mon bureau en chemin de recherche dans autocad.

Et lorsque que le lance la commande "ExpFltr" j'ai:

Commande: ExpFltr
; erreur: no function definition: STR2LST

Merci, à plus.

(gile) · le 18 décembre 2008

Salut,

Merci pour le retour, c'est un oubli, j'ai ajouté la routine str2lst au code ci-dessus (à recopier, donc).

Cette version est une version Beta, je ne désespère pas d'écrire une commande mieux aboutie entièrement en C# (DLL), mais je débute avec ce langage et je n'ai pas beaucoup de temps pour ça.

La Lozère · le 18 décembre 2008

Trop fort ce Gile.

Sa marche nickel. Il faut que je regarde pour le problème en réseau. Mais déja cette routine est adopter par mes collègues.

Merci.

(gile) · le 18 décembre 2008

Re,

La première version est uniquement en LISP, elle ne pose pas les problèmes liés à l'utilisation de DLL mais ne permet d'importer/exporter qu'un filtre à la fois.

PHILPHIL · le 22 décembre 2008

hello gile

ca marche nickel sous version aa2009

juste un petit truc

les filtres de propriétées qui sont avec un espace dans leurs nom n'apparaisent pas dans la liste de choix

"XREF" "TEMPORAIRE" : oui dans la liste de choix

"FAUX PLAFOND" : non ne sont pas dans la liste de choix

voili voila

bonnes fetes de fin d'année( s ) a tous

phil

(gile) · le 22 décembre 2008

Salut,

Je ne comprends pas ton souci, je viens de tester à nouveaux les 2 routines, je n'ai pas eu de de problème avec des nom de filtres contenant des espaces.

PHILPHIL · le 26 décembre 2008

HELLO GILE

ok ca marche

il me fallait juste refaire les noms des filtres avec espaces

il devait y avoir un souci avec car apres importation je me suis retrouvé avec deux filtre de meme nom

et apres suppression d'un des deux tout a plante

merci pour le LISP

a+

phil

[Edité le 26/12/2008 par PHILPHIL]

phil_vsd · le 23 janvier 2009

Hello,

Mille mercis (avec un peu de retard...).

C'est génial.

:D

La Lozère · le 13 mai 2009

Hello,

AU SECOUR (Gile),

Depuis ce matin quand je lance la commande "impfltr" voila ce qu'autocad me renvoi:

Échec de la demande d'autorisation de type
'System.Security.Permissions.FileIOPermission, mscorlib, Version=2.0.0.0,
Culture=neutral, PublicKeyToken=b77a5c561934e089'.

Cela m'embête vraiment car c'est une commande que j'utilise tous les jour.

Merci d'avance.

(gile) · le 13 mai 2009

Salut,

Ce message d'erreur ressemble à celui retourné quand un programme veut charger une DLL placé sur un serveur et que le serveur n'est pas configuré pour laisser l'accès à la DLL.

Tu dois utiliser la version qui utilise GetFilesLisp.dll.

Essaye de mettre la dll dans un dossier du chemin de recherche sur ton poste (et supprime la du serveur qui en interdit l'accès.

Ou alors, il faut forcer l'autorisation d'accès sur chaque poste où c'est nécessaire :

La procédure consiste, sur chaque poste, à ouvrir la fenêtre de commande Windows (Exécuter > cmd), pointer sur répertoire d'instillation de .NET 2.0 (généralement à "c:\windows\microsoft.net\framework\version\") , et entrer la commande suivante (avec le vrai chemin du répertoire où sont placées les DLLs) :

caspol.exe -machine -quiet -addgroup 1 -url "file://Serveur/RépertoireDLL/*" FullTrust

Voir ici

La Lozère · le 13 mai 2009

Merci,

En fait il était à 2 endroit à la fois, sur le serveur et sur mon poste. D'où conflit car j'ai les 2 chemins de recherche dans les options.

A plus

Exporter/importer des filtres de calque

Messages recommandés

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Information importante