WXREF

Fraid · le 11 octobre 2009

Bonjour,

je cherche un moyen de creer des xref de la meme maniere que WBLOC

D"apres vous est-ce possible?

(gile) · le 11 octobre 2009

Salut,

Un petit truc vite fait.

Si j'ai bien compris la demande :

L'utilisateur crée un nouveau fichier et sélectionne des objets dans le dessin courant.

Ces objets sont ajoutés au fichier (wbloc) et supprimés de dessin.

Le fichier est inséré en référence externe.

(defun c:wxref (/ *error* filename ss lst opt)
 (vl-load-com)
 (defun *error* (msg)
   (or (= msg "Fonction annulée")
       (princ (strcat "\nErreur: " msg))
   )
   (and ss (vla-delete ss))
   (foreach l lst (vla-put-Lock l :vlax-true))
   (vla-EndUndoMark acdoc)
   (princ)
 )
 (setq acdoc (vla-get-Activedocument (vlax-get-acad-object)))
 (if (setq filename (getfiled "Créer un fichier" (getvar 'dwgprefix) "dwg" 1))
   (progn
     (initget "Attacher Superposer")
     (setq opt
            (if (= (getkword "\nType de référence [Attacher/Superposer] : ")
                   "Superposer"
                )
              :vlax-true
              :vlax-false
            )
     )
   (if (ssget)
     (progn
       (vla-StartUndoMark acdoc)
       (setq ss (vla-get-ActiveSelectionSet acdoc))
       (vla-Wblock acdoc filename ss)
       (vlax-for l (vla-get-Layers acdoc)
         (and (= (vla-get-Lock l) :vlax-true)
              (setq lst (cons l lst))
              (vla-put-Lock l :vlax-false)
         )
       )
       (vlax-for o ss (vla-delete o))
       (vla-delete ss)
       (setq ss nil)
       (foreach l lst (vla-put-Lock l :vlax-true))
       (vla-AttachExternalReference
         (vla-get-ModelSpace acdoc)
         filename
         (vl-filename-base filename)
         (vlax-3d-point '(0. 0. 0.))
         1.
         1.
         1.
         0.
         opt
       )
       (vla-EndUndoMark acdoc)
     )
   )
   )
 )
 (princ)
)

lili2006 · le 11 octobre 2009

Bonsoir à toutes et tous,

Génial Gilles, :D

Quel est le type d'attachement de cette REF créée ?

Merci d'avance,

(gile) · le 11 octobre 2009

La xref est de type "attachée", si tu préfères "superposée", il faut remplacer :vlax-false par :vlax-true dans l'expression :

(vla-AttachExternalReference
 (vla-get-ModelSpace acdoc)
 filename
 (vl-filename-base filename)
 (vlax-3d-point '(0. 0. 0.))
 1.
 1.
 1.
 0.
 :vlax-false
)

lili2006 · le 11 octobre 2009

Re,

Ok !

Non, ça me va très bien attaché, mais on peut être amené à superposer, donc c'est bon de le savoir,..

Merci encore, :P

Fraid · le 12 octobre 2009

Merci beaucoup Gilles

C'est exactement ce que je cherchais

aussi a Lili car il m'arrive aussi de les superposées

salvanorigatore · le 12 octobre 2009

(gile) tu es tout simplement génial

et si tu veux mon opinion cet outils on n'a pas fini de l'utiliser...:heartpump:

merci.

(gile) · le 12 octobre 2009

Salut,

En écrivant cette petite routine je me disais bien qu'elle risquait de plaire.

Je suis content que ce soit le cas.

En ce qui concerne le type de référence, j'ai modifié la routine pour permettre le choix entre les options "Attacher" et "Superposer" (défaut = "Attacher").

lili2006 · le 12 octobre 2009

Bonsoir à toutes et tous,

Que dire ?

Allez, on rabâche : Merci Gilles et merci à Fraid d'avoir posé cette question parce que franchement, maintenant je me demande comment personne n'a pu y penser avant,.... :o

Je vois d'ici les multiples applications,...

lovecraft · le 12 octobre 2009

Bonsoir,

Effectivement bien sympa cette routine. un grand merci Gile

J'aurais une petite question: Du moins est ce possible ?

Exemple: Prenons un fichier dwg dans lequel j'ai plusieurs calques.

J'aimerais une routine qui puisse créer un fichier dwg de chaque couche. De plus il faudrait que l e nom du fichier reprenne le nom du calque.

Voilou

Cordialement,

Laurent

(gile) · le 12 octobre 2009

Voilà :

(defun c:LayerToDwg (/ acdoc layers prefix name ss)
 (vl-load-com)
 (setq acdoc  (vla-get-ActiveDocument (vlax-get-acad-object))
       layers (vla-get-Layers acdoc)
       prefix (getvar 'dwgprefix)
 )
 (vlax-for l layers
   (setq name (vla-get-Name l))
   (if (ssget "_X" (list '(410 . "Model") (cons 8 name)))
     (progn
       (setq ss (vla-get-ActiveSelectionSet acdoc))
       (vla-Wblock acdoc (strcat prefix name ".dwg") ss)
       (vla-delete ss)
     )
   )
 )
 (princ)
)

lili2006 · le 12 octobre 2009

Re,

Le festival aujourd'hui,...

Peut également s'avérer très utile,... :P

salvanorigatore · le 13 octobre 2009

lovecraft, (gile),

je ne sais pas ce que ça vaut (le lisp et moi ça fait deux ... :red: ) mais j'avais déjà trouvé un lisp qui faisait ça, le voici :

 (defun c:calquesenblocs (/ first unplan i lg-list-layers fichier js layer rep-cou lesplan)
(setvar "filedia" 0)
(setvar "cmddia" 0)
(setvar "cmdecho" 0)
(command "-calque" "ACtif" "*" "Libérer" "*" "Déverrouiller" "*" "")
(setq rep-cou (getvar "DWGPREFIX"))
(setq first T)
(while (setq unplan (tblnext "layer" first))
(setq first nil)
(setq lesplan (append lesplan (list (cdr (assoc 2 unplan)))))
);fin while
(setq lg-list-layers (length lesplan))
(setq i 0)
(while (< i lg-list-layers)
(setq layer (nth i lesplan))
(setq filtre (list (cons 8 layer)))
(setq js (ssget "X" filtre))
(setq fichier (strcat rep-cou layer))
(command "-wbloc" fichier "" "0,0" js "")
(setq i (+ i 1))
);fin while
(princ)
(setvar "filedia" 1)
(setvar "cmddia" 1)
(setvar "cmdecho" 1)
);fin defun

merci en tout cas à (gile) pour son lisp et rapide en plus :cool:

voilà, bonne journée à tous.

lecrabe · le 23 octobre 2009

Hello Gilles

J'adore LAYERTODWG mais j'aimerais bien qu'il ne traite pas certains calques !

Donc sans demander une grosse modif, on pourrait imaginer

une petite question supplementaire :

Voulez vous traiter les calques verrouilles (Defaut = N) ?

Ainsi il suffirait de verrouiller TOUS les calques que l'on ne veut pas traiter

par exemple le calque ZERO, etc ...

Sauvegarder l'etat de calque AVANT , LAYERTODWG , restaurer l'etat de calque

et HOP, ca roule ! :D

Le Decapode (qui a toujours des idees "saugrenues")

(gile) · le 23 octobre 2009

Salut,

Un petit truc vite fait avec une boite de dialogue pour sélectionner les calques à traiter.

NB : s'il n'y a aucune entité dans l'espace objet sur un calque, celui n'est bien sûr pas traité. Les calques des xrefs attachées sont aussi écartés.

;; LAYERTODWG (gile)
;; Crée un fichier DWG pour chaque calque sélectionné

(defun c:LayerToDwg (/ acdoc layers prefix name llst ss)
 (vl-load-com)
 (setq acdoc  (vla-get-ActiveDocument (vlax-get-acad-object))
       layers (vla-get-Layers acdoc)
       prefix (getvar 'dwgprefix)
 )
 (vlax-for l layers
   (setq name (vla-get-Name l))
   (if (not (wcmatch name "*|*"))
     (setq llst (cons name llst))
   )
 )
 (setq llst (vl-sort llst '        llst (ListBox "LayerToDwg"
                "Sélectionnez les calques à traiter"
                (mapcar 'cons llst llst)
                2
       )
 )
 (foreach name llst
   (if (ssget "_X" (list '(410 . "Model") (cons 8 name)))
     (progn
       (setq ss (vla-get-ActiveSelectionSet acdoc))
       (vla-Wblock acdoc (strcat prefix name ".dwg") ss)
       (vla-delete ss)
     )
   )
 )
 (princ)
)

;; 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" (mapcar 'cons (layoulist) (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
)

;; str2lst
;; Transforme un chaine avec séparateur en liste de chaines
;;
;; Arguments
;; str : la chaine à transformer en liste
;; sep : le séparateur
;;
;; Exemples
;; (str2lst "a b c" " ") -> ("a" "b" "c")
;; (str2lst "1,2,3" ",") -> ("1" "2" "3")
;; (mapcar 'read (str2lst "1,2,3" ",")) -> (1 2 3)

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

lecrabe · le 23 octobre 2009

Hello Gilles

Merci beaucoup mais il manque la fonction STR2LST :o

Le Decapode

(gile) · le 23 octobre 2009

Oupss !

C'est réparé.

lecrabe · le 23 octobre 2009

ReHello Gilles

C TIP-TOP ! :)

Merci, Le Decapode

Connexion

WXREF

Messages recommandés

Fraid

(gile)

lili2006

(gile)

lili2006

Fraid

salvanorigatore

(gile)

lili2006

lovecraft

(gile)

lili2006

salvanorigatore

lecrabe

(gile)

lecrabe

(gile)

lecrabe

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante