XREFS (detache insert explode)

[sergeluc]

voir routine dans ci-dessous

 

 

 

 

 

[Edité le 2/7/2006 par sergeluc]

[sergeluc]

Bonjour,

voici le résultat de mes élucubrations pour traiter des xrefs sur Autocad 2000 et 2006

en supprimant ceux déclarés dont le chemin n'est pas reconnu ,en insérant en bloc ceux qu'ils le sont et en les explosant.Mon problème se posait sutout sur la version acad2000.

En récupérant a droite et à gauche des bouts de code et surtout avec l'aide de Gile ,je suis

arrivé à cette compilation qui fonctionne et pourra sans doute etre améliorée .

 

 
;Le 30/06/06 DETACHEMENT des xrefs dont le chemin n'est plus valide
;insertion en bloc et explosion du (des) bloc(s) des xrefs valides
;fonctionne en acad2000 et 2006
 ;------------------

(defun c:detach-ins-ref (/ cmd bl rc n tot AcDoc rep itm)
 (vl-load-com)
 (setq
   cmd (getvar "cmdecho")
   tot 0
   bl  (tblnext "block" t)
   l2  nil
   l3  nil
   rep "*\\*"
   ) ;_ Fin de setq
 (setvar "cmdecho" 0)
 (command "_.undo" "_group")

 (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (while bl
   (if (= (logand (cdr (assoc 70 bl)) 4) 4)
     (progn
       (setq
         rc (cdr (assoc 1 bl))
         n  (substr rc 1 (- (strlen rc) 4)) 
         ) ;_ Fin de setq

       (if
         (and
           (not (findfile rc))
           (not (wcmatch (cdr (assoc 1 bl)) rep))
           ) ;and
 ;liste des xrefs nommés dans la liste sans chemins
          (progn
            (setq l2 (cons n l2))
            (setq tot (1+ tot))
            ) ;_ Fin de progn
 ;liste des xrefs nommés dans la liste avec chemins
(progn
            (setq l3 (cons n l3))
            (setq tot (1+ tot))
);progn
          ) ;_ Fin de if
       ) ;_ Fin de progn
     ) ;_ Fin de if xref
   (setq bl (tblnext "block"))
   ) ;_ Fin de while

     (deverou-cal)
 ;---------------------------------------------
 (if l2
 ;on détache les xrefs sans chemins
     (foreach x l2
       (vla-detach (vla-item (vla-get-Blocks AcDoc) x))
       ) ;foreach
   ) ;if l2
 ;---------------------------------------------
 (if l3
(xref-ins-2000);pour acad2000 et 2006
  ) ;if l3

(setq
   l2  nil
   l3  nil
   ss  nil
);setq

(restor-cal)
(vla-PurgeAll AcDoc)  
 (command "_.undo" "_end")
 (setvar "cmdecho" cmd)
 (princ)
 ) ;_ Fin de defun
;-----------------------------------
   ;; Dévérouillage de tous les calques 
(defun deverou-cal ()
     (repeat (setq n (vla-get-count (vla-get-Layers AcDoc)))
       (setq lay (vla-item (vla-get-Layers AcDoc) (setq n (1- n))))
       (if (= :vlax-true
              (vla-get-lock lay)
              ) ;_ Fin de =
         (progn
           (vla-put-lock lay :vlax-false)
           (setq l_lst (cons lay l_lst))
           ) ;_ Fin de progn
         ) ;_ Fin de if
       ) ;_ Fin de repeat
);defun
 ;---------------------------------------------
     ;; Restauration de l'état des calques
(defun restor-cal ()
     (if l_lst
       (mapcar '(lambda (x)
                  (vla-put-lock x :vlax-true)
                  ) ;_ Fin de lambda
               l_lst
               ) ;_ Fin de mapcar
       ) ;_ Fin de if
);defun
 ;---------------------------------------------
(defun xref-ins-2000 ( / s-bind nb s-visr)
(setq s-bind (getvar "bindtype"))
(setq s-visr (getvar "visretain"))
(setvar "bindtype" 1)
(setvar "visretain" 1)
 
 (if
   (setq nb (ssget "x" '((0 . "insert"))))
   (progn
     (setq nb (mapcar 'vlax-ename->vla-object
    (vl-remove-if 'listp
    (mapcar 'cadr (ssnamex nb)
      )
    )
          )
     );setq
 (foreach item nb
 (if (vlax-property-available-p item "path")
(progn
   (command "_xref" "_bind" (vla-get-name item));attacher ou lier suivant bindtype
(setq ss  (ssget "X" (list '(0 . "INSERT") (cons 2 (vla-get-name item)))))
(command "_explode" ss)

);progn
   );if
   );foreach
     );progn
   );if

(setvar "bindtype" s-bind)
(setvar "visretain" s-visr)
 (princ)
 )
;---------------
;nota : 
;(command "_-xref" "_bind" "*");marche en acad2006 et pas en 2000
;vla-get-Path pose des problémes en autocad2000