Aller au contenu

Exporter/importer des filtres de calque


(gile)
 Partager

Messages recommandés

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)]

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Lien vers le commentaire
Partager sur d’autres sites

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,...)

Civil 3D 2022 - COVADIS_17.1d

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

Lien vers le commentaire
Partager sur d’autres sites

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) ;)

Lien vers le commentaire
Partager sur d’autres sites

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.

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Lien vers le commentaire
Partager sur d’autres sites

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,

Civil 3D 2022 - COVADIS_17.1d

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

Lien vers le commentaire
Partager sur d’autres sites

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à.

Tous pour lisp, Lisp pour tous!

Avec Revit, cela ne vas trop vite...

Lien vers le commentaire
Partager sur d’autres sites

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".

 

 

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Lien vers le commentaire
Partager sur d’autres sites

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

Civil 3D 2022 - COVADIS_17.1d

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

Lien vers le commentaire
Partager sur d’autres sites

  • 2 semaines après...

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)
 )
) 

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Lien vers le commentaire
Partager sur d’autres sites

  • 1 mois après...

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.

www.cad-is.fr
Autocad Map 2021 - Covadis/Autopiste V17.1d - Mensura Genius V8
Nous n’héritons pas de la Terre de nos ancêtres, nous l’empruntons à nos enfants
Lien vers le commentaire
Partager sur d’autres sites

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.

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Lien vers le commentaire
Partager sur d’autres sites

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.

www.cad-is.fr
Autocad Map 2021 - Covadis/Autopiste V17.1d - Mensura Genius V8
Nous n’héritons pas de la Terre de nos ancêtres, nous l’empruntons à nos enfants
Lien vers le commentaire
Partager sur d’autres sites

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

Autodesk Architecture 2019 sous windows 10 64

24 pouces vertical + 30 pouces horizontal + 27 pouces horizontal

Lien vers le commentaire
Partager sur d’autres sites

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]

Autodesk Architecture 2019 sous windows 10 64

24 pouces vertical + 30 pouces horizontal + 27 pouces horizontal

Lien vers le commentaire
Partager sur d’autres sites

  • 4 semaines après...
  • 3 mois après...

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.

www.cad-is.fr
Autocad Map 2021 - Covadis/Autopiste V17.1d - Mensura Genius V8
Nous n’héritons pas de la Terre de nos ancêtres, nous l’empruntons à nos enfants
Lien vers le commentaire
Partager sur d’autres sites

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

 

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Lien vers le commentaire
Partager sur d’autres sites

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

www.cad-is.fr
Autocad Map 2021 - Covadis/Autopiste V17.1d - Mensura Genius V8
Nous n’héritons pas de la Terre de nos ancêtres, nous l’empruntons à nos enfants
Lien vers le commentaire
Partager sur d’autres sites

Rejoindre la conversation

Vous pouvez publier maintenant et vous inscrire plus tard. Si vous avez un compte, connectez-vous maintenant pour publier avec votre compte.

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.

Chargement
 Partager

×
×
  • 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é