Répartir les type d\'objets en calques

[Cyrchap]

Salut à tous,

Y a t'il quelqu'un qui a connaissance d'un lisp qui réparti les types d'objet (texte, ligne, hachures, blocs..) qui sont inserés dans un calque vers des "sous" calques.

Exemple dans 1 fichier il y a plusieurs calques A, B, C dans A il y a des entités polyligne texte et hachure, dans B il y a des textes et des polylignes 3d et des blocs etc...

 

Au final je voudrais que le calque A se decompose en A_Texte, A_hachures, A_Poly et que B

devienne B_Texte, B_poly3d, B_blocs etc....de meme pour tous les autres calques du fichier.

Quand le fichier est simple avec les filtres on y arrive, mais avec des fichiers plus complexe la tache devient lourde.

 

Merci pour votre aide

 

[Patrick_35]

Salut

 

Je me suis amusé à faire quelque chose vite fait

 

(defun c:tri(/ doc ent lay lck nom ori pro sel tot txt)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark doc)
 (if (ssget "x")
   (progn
     (vlax-for ent (setq sel (vla-get-activeselectionset doc))
(setq txt (substr (vla-get-objectname ent) 5)
      tot 2
)
(while (and (> (vl-string-elt txt tot) 90)
	    (< tot (1- (strlen txt)))
       )
  (setq tot (1+ tot))
)
(and (eq (1- (strlen txt)) tot)
  (setq tot (1+ tot))
)
(setq nom (substr txt 1 tot)
      ori (vla-item (vla-get-layers doc) (vla-get-layer ent))
      lck (vla-get-lock ori)
)
(if (wcmatch (vla-get-layer ent) (strcat "* - " nom))
  (setq txt (vla-get-layer ent))
  (setq txt (strcat (vla-get-layer ent) " - " nom))
)
(or (eq (vla-get-layer ent) txt)
    (and (vl-catch-all-error-p (setq lay (vl-catch-all-apply 'vla-item (list (vla-get-layers doc) txt))))
	 (setq lay (vla-add (vla-get-layers doc) txt))
	 (foreach pro '('color 'freeze 'layeron 'linetype 'lineweight 'material 'plottable 'viewportdefault)
	   (vlax-put lay (eval pro) (vlax-get ori (eval pro)))
	 )
    )
    (vla-put-lock lay :vlax-false)
    (vla-put-lock ori :vlax-false)
    (vla-put-layer ent txt)
    (vla-put-lock lay lck)
    (vla-put-lock ori lck)
)
     )
     (princ (strcat "\nTravail sur " (itoa (vla-get-count sel)) " objet(s)."))
     (vla-delete sel)
   )
   (princ "\nDessin vide.")
 )
 (vla-endundomark doc)
 (princ)
)

 

@+

[Cyrchap]

Merci Patrick_35 mais le lisp ne fonctionne pas, j'ai une erreur dans la ligne de commande apres avoir lancé la commande tri.

 

; erreur: no function definition: VLAX-GET-ACAD-OBJECT

 

ça va pas plus loin, j'ai récuperé tes lignes par copier collé, je ne pense pas avoir oublié quelque chose.

Je suis sur map2008 est ce a cause de cela ou pas ????

Merci

A+

[lili2006]

Bonsoir à toutes et tous,

 

Et comme ça ?

 

 

[b][color=#FF0000] (vl-load-com)[/color][/b]
(defun c:tri(/ doc ent lay lck nom ori pro sel tot txt)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark doc)
 (if (ssget "x")
   (progn
     (vlax-for ent (setq sel (vla-get-activeselectionset doc))
(setq txt (substr (vla-get-objectname ent) 5)
      tot 2
)
(while (and (> (vl-string-elt txt tot) 90)
	    (	       )
  (setq tot (1+ tot))
)
(and (eq (1- (strlen txt)) tot)
  (setq tot (1+ tot))
)
(setq nom (substr txt 1 tot)
      ori (vla-item (vla-get-layers doc) (vla-get-layer ent))
      lck (vla-get-lock ori)
)
(if (wcmatch (vla-get-layer ent) (strcat "* - " nom))
  (setq txt (vla-get-layer ent))
  (setq txt (strcat (vla-get-layer ent) " - " nom))
)
(or (eq (vla-get-layer ent) txt)
    (and (vl-catch-all-error-p (setq lay (vl-catch-all-apply 'vla-item (list (vla-get-layers doc) txt))))
	 (setq lay (vla-add (vla-get-layers doc) txt))
	 (foreach pro '('color 'freeze 'layeron 'linetype 'lineweight 'material 'plottable 'viewportdefault)
	   (vlax-put lay (eval pro) (vlax-get ori (eval pro)))
	 )
    )
    (vla-put-lock lay :vlax-false)
    (vla-put-lock ori :vlax-false)
    (vla-put-layer ent txt)
    (vla-put-lock lay lck)
    (vla-put-lock ori lck)
)
     )
     (princ (strcat "\nTravail sur " (itoa (vla-get-count sel)) " objet(s)."))
     (vla-delete sel)
   )
   (princ "\nDessin vide.")
 )
 (vla-endundomark doc)
 (princ)
) 

[Cyrchap]

Ok effectivement avec (vl-load-com) en + ça roule.

J'ai testé, j'ai validé, j'ai rien à dire sauf merci

Le ménage et le tri dans les fichiers que je reçois sera plus facile.

 

Merci encore

Salut

 

 

[lecrabe]

 

Hello P35

 

Ca fonctionne sur AutoCAD versions 2008 & 2009

et ne fonctionne pas sur versions 2006 et antérieures :)

 

Cela fonctionne t-il sur une 2007 ? :casstet:

 

En sortie de traitement, il n'y a plus aucun objet sur les calques d'origine,

c Normal bien sur :P

 

Le Decapode "testeur"

 

[lecrabe]

 

ReHello

 

Une pette critique du Crabe (comme d'hab !) :)

 

Il serait utile (A mon avis) de différencier BLOCK & XREF ! :P

 

Le Decapode "toujours critique"

 

[Chanoine]

Citation de Le Crabe : Ca fonctionne sur AutoCAD versions 2008 & 2009

et ne fonctionne pas sur versions 2006 et antérieures ...

Pourquoi cette désagréable impression que ceux qui travaillent sur des versions anciennes vont de plus en plus être exclus des routines produites? :casstet:

J'imagine ce que doivent ressentir les confrêres qui travaillent sous R12, R14 ou LT97/98... :exclam:

Fais pas bon de vieillir... :cool:

En même temps c'est normal, il faut vivre avec les évolutions techniques de son temps, surtout quand elles sont positives... et j'ai qu'à finir mon auto-apprentissage du language Autolisp, graine de feignant que je suis :cool: même si c'est bien dur tout seul

;)

 

Edit: Ah oui, j'oublie la vraie raison de ce message: Cher Lili 2006, pourquoi faut-il ajouter (vl-load-com) en tête de la routine? Je ne comprend pas son utilité... :(

 

[Edité le 24/3/2009 par Chanoine]

[lecrabe]

 

Hello

 

A cause de toutes les fonctions VLA* utilisées par Patrick_35 !

 

Il faut DONC ajouter l'instruction : (vl-load-com)

afin que le V-Lisp s'initialise ...

 

Le Decapode

 

[Chanoine]

Ah, d'accord!

Merci Le Crabe! ;)

[Patrick_35]

Salut

 

Une version spécial testaropode ;)

 

(defun c:tri(/ doc ent lay lck nom ori pro sel tot txt)
 (vl-load-com)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark doc)
 (if (ssget "x")
   (progn
     (vlax-for ent (setq sel (vla-get-activeselectionset doc))
(cond
  ((and (eq (vla-get-objectname ent) "AcDbBlockReference")
	(vlax-property-available-p ent 'path)
    )
    (setq nom "Xref")
  )
  (T
    (setq txt (substr (vla-get-objectname ent) 5)
	  tot 2
    )
    (while (and (> (vl-string-elt txt tot) 90)
		(< tot (1- (strlen txt)))
	   )
      (setq tot (1+ tot))
    )
    (and (eq (1- (strlen txt)) tot)
      (setq tot (1+ tot))
    )
    (setq nom (substr txt 1 tot))
  )
)
(setq ori (vla-item (vla-get-layers doc) (vla-get-layer ent))
      lck (vla-get-lock ori)
)
(or (wcmatch (vla-get-layer ent) (strcat "* - " nom))
    (and (vl-catch-all-error-p (setq lay (vl-catch-all-apply 'vla-item (list (vla-get-layers doc) (setq txt (strcat (vla-get-layer ent) " - " nom))))))
	 (setq lay (vla-add (vla-get-layers doc) txt))
	 (foreach pro '('color 'freeze 'layeron 'linetype 'lineweight 'material 'plottable 'viewportdefault)
	   (and (vlax-property-available-p lay (eval pro))
	     (vlax-put lay (eval pro) (vlax-get ori (eval pro)))
	   )
	 )
    )
    (vla-put-lock lay :vlax-false)
    (vla-put-lock ori :vlax-false)
    (vla-put-layer ent txt)
    (vla-put-lock lay lck)
    (vla-put-lock ori lck)
)
     )
     (princ (strcat "\nTravail sur " (itoa (vla-get-count sel)) " objet(s)."))
     (vla-delete sel)
   )
   (princ "\nDessin vide.")
 )
 (vla-endundomark doc)
 (princ)
)

 

et j'ai qu'à finir mon auto-apprentissage du language Autolisp, graine de feignant que je suis même si c'est bien dur tout seul

Et Cadxp :D

 

ps : le lisp doit normalement passer toutes les versions à partir de la 2000.

 

@+

 

[Edité le 24/3/2009 par Patrick_35]

[lecrabe]

 

Hello P35

 

Nouvelle version testée et validée sur MAP 2004 et sur MAP 2008 ! :)

 

Merci, Le Decapode

 

[Chanoine]

Validé pour AutoCAD 2002 et 2006! :) :) :)

Bravo Patrick_35! ;)

 

En effet, l'ami Cad'xp est toujours là en cas de galères... et pour les meilleurs moments (bref, pour moi, l'apprentissage, car je trouve que c'est ce qu'il y a de meilleur dans le boulot: tous les jours, apprendre un peu plus :D )!!!

 

[lecrabe]

 

Hello

 

Voici la micro-modif que j'ai réalisé :

ainsi les noms de calque générés ont un double underscore/souligné ("__")

AVANT le type d'entité graphique ...

 

;; (or (wcmatch (vla-get-layer ent) (strcat "* - " nom))

;; (and (vl-catch-all-error-p (setq lay (vl-catch-all-apply 'vla-item (list ;; (vla-get-layers doc) (setq txt (strcat (vla-get-layer ent) " - " nom))))))

 

devient

 

(or (wcmatch (vla-get-layer ent) (strcat "*__" nom))

(and (vl-catch-all-error-p (setq lay (vl-catch-all-apply 'vla-item (list (vla-get-layers doc) (setq txt (strcat (vla-get-layer ent) "__" nom))))))

 

Le Decapode "qui hait les espaces/blancs dans les noms de calque"