Remplacer plusieurs objets identiques par autant de blocs

kant_ein · le 16 juin 2011

Bonjour,

Malgré de nombreuses recherches ici et ailleurs, je ne trouve toujours pas de solution à mon problème. Sans doute (certainement) pourrez-vous m'aider !

Je souhaite remplacer de multiples objets identiques par autant de blocs. En fait, j'ai récupéré un dessin dans lequel certains éléments sont représentés par des polylignes fermées toutes de caractéristiques identiques au lieu d'être représentés par autant de blocs d'une seule et même définition.

Je vois bien la manipulation qui pourrait être faite mais je ne maîtrise pas la programmation AutoCad... Voilà comment je vois les choses :

- sélection de toutes les polylignes concernées (critères : calque et aire)

- conversion itérative de chacune de ces polylignes en bloc (toto-i avec i=0 à nb de polylignes sélectionnées)

Ensuite il me suffira d'utiliser le lisp rbloc de Patrick35 pour n'avoir plus qu'une seule définition de bloc.

Merci d'avance.

bryce · le 16 juin 2011

Bonjour,

A mon avis, il n'y pas d'autre moyen que de passer par un lisp...

As-tu la possibilité de poster un échantillon de dessin ?

kant_ein · le 21 juin 2011

Bonjour,

Je m'orientais effectivement vers un lisp mais je n'ai pas encore eu le loisir de me plonger dans ce langage... Est-ce faisable en VBA ? J'ai beaucoup utilisé ce langage sous Excel pour traiter de (très) grandes quantités de données.

Un échantillon de dessin n'apporterait pas grand-chose. Pour rentrer dans les détails, j'ai près de 600 "carrés" représentant des regards d'assainissement. Je souhaite transformer ces polylignes en bloc.

La sélection filtrée des polylignes est simple. Par contre, la syntaxe pour faire une boucle sélectionnant chaque polyligne l'une après l'autre pour en faire un bloc m'est totalement inconnue...

A votre bon coeur, m'sieurs dames !

bryce · le 21 juin 2011

Bonjour,

Pour ma part je n'ai pas fait beaucoup de VBA, mais voici un lisp qui pourrait servir de base de départ :

(defun c:PO2BL (/ bname *error* obj acdoc ms blks blk ss ent ent2 count lay pt i nbname)
; Crée un bloc pour chaque polyligne sélectionnée.
; Brice Studer, juin 2011
;
;~~~~~~~ CONFIG ~~~~~~~~~~~
(setq bname "BL_") ; préfixe du nom des blocs créés
;~~~~~~~ FIN CONFIG ~~~~~~~~~~~

(vl-load-com)
;~~~~~~~ SOUS-FONCTIONS ~~~~~~~~~~~
(defun gc:VariantToLispData (var)
; par (gile)
 (cond
   ((= (type var) 'variant)
    (gc:VariantToLispData (vlax-variant-value var)))
   ((= (type var) 'safearray)
    (mapcar 'gc:VariantToLispData (vlax-safearray->list var))
   )
   (T var)
 )
)
;~~~~~~~ FIN SOUS-FONCTIONS ~~~~~~~~~~~

(setq	obj (vlax-get-acad-object)
	acdoc (vla-get-ActiveDocument obj)
	ms (vla-get-modelspace acdoc)
	blks (vla-get-blocks acdoc)
)

(defun *error* (msg)
(and msg
	(or
		(member (strcase msg) '("FUNCTION CANCELLED" "QUIT / EXIT ABORT" "FONCTION ANNULEE" "QUITTER / SORTIR ABANDON"))
		(princ (strcat "\nErreur : " msg))
	)
)
(if ss (vla-delete ss))
(vla-endundomark acdoc)
(princ)
)

(vla-startundomark acdoc)

(setq count 0)
(if (setq	ss	(ssget '( (-4 . "") ))	)
(progn
	(initget "Courant Origine")
	(setq lay (getkword "\nCalque pour l'insertion des blocs [Courant/Origine] : "))
	(if (not lay) (setq lay "Courant"))
	(setq ss (vla-get-activeselectionset acdoc))
	(setq i 1)
	(vlax-for ent ss
		(cond
			((= (vla-get-objectname ent) "AcDb3dPolyline")
				(setq pt (vlax-3d-point (gc:VariantToLispData (vla-get-coordinate ent 0))))
			)
			((or
				(= (vla-get-objectname ent) "AcDbPolyline")
				(= (vla-get-objectname ent) "AcDb2dPolyline")
			)
				(setq pt (gc:VariantToLispData (vla-get-coordinate ent 0)))
				(setq pt (vlax-3D-point (list (car pt) (cadr pt) (vla-get-elevation ent))))
			)
		)
		; début création des blocs
		(while
			(tblsearch "BLOCK" (strcat bname (itoa i) ))
			(setq i (1+ i))
		)
		(setq blk (vla-add blks pt (setq nbname (strcat bname (itoa i) ))) )
		(vla-put-layer (setq ent2 (vla-copy ent)) "0")
		(vla-copyobjects acdoc (vlax-safearray-fill (vlax-make-safearray  vlax-vbObject (cons 0 0)) (list ent2)) blk)
		(setq blk (vla-insertblock ms pt nbname 1 1 1 0))
		(if (= lay "Origine")(vla-put-layer blk (vla-get-layer ent)))
		(vla-delete ent2)
		(vla-delete ent); effacement de la polyligne d'origine
		(setq count (1+ count))
		; fin création des blocs
	);vlax-for ent
);progn if ss
);if ss
(princ (strcat "\n" (itoa count) " blocs créés."))
(*error* nil)
);

(princ "\nCommande à utiliser: PO2BL")
(princ)

C'est une version "allégée" d'un lisp que j'avais écrit suite à une demande de lecrabe ( http://www.cadxp.com/modules.php?op=modload&name=XForum&file=viewthread&tid=31981 ).

[Edité le 21/6/2011 par bryce]

kant_ein · le 21 juin 2011

Merci pour tout. J'essaie de décrypter ça et je le testerai demain au taf.

Comme dirait l'autre : yapuka !

Je ferai un suivi de ce post.

kant_ein · le 22 juin 2011

Bonjour,

Ce lisp répond parfaitement à mes besoins. Enfin... à un détail près : le point d'insertion du bloc. Celui-ci est défini sur le premier sommet de la polyligne. Idéalement, il faudrait qu'il soit défini sur le centroïde de la polyligne.

J'ai trouvé ici un lisp qui convertit les polylignes fermées en région, crée un point au niveau du centroïde puis supprime la région.

Je pensais combiner les 2 mais le lisp pt-cen refuse de sélectionner mes polylignes... Le problème semble se situer dans les lignes de codes suivantes mais je ne sais pas quoi modifier pour que cela fonctionne.

;; Sélection à l'écran (filtre les lwpolylignes fermées)
 (vla-SelectOnScreen
   SelSet
   (vlax-SafeArray-fill
     (vlax-make-SafeArray
vlax-vbInteger
'(0 . 1)
     )
     '(0 70)
   )
   (vlax-SafeArray-fill
     (vlax-make-SafeArray
vlax-vbVariant
'(0 . 1)
     )
     (list "LWPOLYLINE" 1)
   )
 )

Edit : pourquoi ce lien pointe sur la page d'accueil du site ? Les crochets des balises ont volontairement été remplacés par des accolades pour que l'adresse soit visible.

{url="http://www.cadxp.com/modules.php?op=modload&name=XForum&file=viewthread&tid=2482#pid44671"}ici{/url}

[Edité le 22/6/2011 par kant_ein]

bryce · le 22 juin 2011

Bonjour,

J'ai modifié le lisp pour utiliser le centre de gravité comme point de base du bloc (seules les lwpolylines sont supportées) :

(defun c:PO2BL (/ bname *error* obj acdoc as blks blk ss ent ent2 region count errcount errflag lay pt i nbname)
; Crée un bloc pour chaque polyligne sélectionnée.
; Brice Studer, juin 2011
;
;~~~~~~~ CONFIG ~~~~~~~~~~~
(setq bname "BL_") ; préfixe du nom des blocs créés
;~~~~~~~ FIN CONFIG ~~~~~~~~~~~

(vl-load-com)
;~~~~~~~ SOUS-FONCTIONS ~~~~~~~~~~~
(defun gc:VariantToLispData (var)
; par (gile)
 (cond
   ((= (type var) 'variant)
    (gc:VariantToLispData (vlax-variant-value var)))
   ((= (type var) 'safearray)
    (mapcar 'gc:VariantToLispData (vlax-safearray->list var))
   )
   (T var)
 )
)
;~~~~~~~ FIN SOUS-FONCTIONS ~~~~~~~~~~~

(setq	obj (vlax-get-acad-object)
	acdoc (vla-get-ActiveDocument obj)
	blks (vla-get-blocks acdoc)
)
(if (= (getvar "CVPORT") 1)
   (setq as (vla-get-paperspace acdoc))
   (setq as (vla-get-modelspace acdoc))
 )

(defun *error* (msg)
(and msg
	(or
		(member (strcase msg) '("FUNCTION CANCELLED" "QUIT / EXIT ABORT" "FONCTION ANNULEE" "QUITTER / SORTIR ABANDON"))
		(princ (strcat "\nErreur : " msg))
	)
)
(if ss (vla-delete ss))
(vla-endundomark acdoc)
(princ)
)

(vla-startundomark acdoc)

(setq count 0)
(setq errcount 0)
(if (setq	ss	(ssget '( (-4 . "") ))	)
(progn
	(initget "Courant Origine")
	(setq lay (getkword "\nCalque pour l'insertion des blocs [Courant/Origine] : "))
	(if (not lay) (setq lay "Courant"))
	(setq ss (vla-get-activeselectionset acdoc))
	(setq i 1)
	(vlax-for ent ss
		(setq region (vlax-invoke as 'Addregion (list ent)))
		(if
			(not
				(vl-catch-all-error-p
					(setq pt (vl-catch-all-apply 'vla-get-centroid region))
				)
			)
			(progn
				(setq errflag nil)
				(setq pt (vlax-3d-point (trans (gc:VariantToLispData pt) 1 0)))
			)
			(progn
				(setq errflag T)
				(setq errcount (1+ errcount))
			)
		)
		(vla-delete (car region))
		; début création des blocs
		(if (not errflag)
			(progn
				(while
					(tblsearch "BLOCK" (strcat bname (itoa i) ))
					(setq i (1+ i))
				)
				(setq blk (vla-add blks pt (setq nbname (strcat bname (itoa i) ))) )
				(vla-put-layer (setq ent2 (vla-copy ent)) "0")
				(vla-copyobjects acdoc (vlax-safearray-fill (vlax-make-safearray  vlax-vbObject (cons 0 0)) (list ent2)) blk)
				(setq blk (vla-insertblock as pt nbname 1 1 1 0))
				(if (= lay "Origine")(vla-put-layer blk (vla-get-layer ent)))
				(vla-delete ent2)
				(vla-delete ent); effacement de la polyligne d'origine
				(setq count (1+ count))
			)
		); fin création des blocs
	);vlax-for ent
);progn if ss
);if ss
(princ (strcat "\n" (itoa errcount) " objets ignorés."))
(princ (strcat "\n" (itoa count) " blocs créés."))
(*error* nil)
);

(princ "\nCommande à utiliser: PO2BL")
(princ)

[Edité le 22/6/2011 par bryce]

kant_ein · le 23 juin 2011

Bonjour,

C'est parfait ! Cela répond exactement à mes besoins.

Merci beaucoup.

Connexion

Remplacer plusieurs objets identiques par autant de blocs

Messages recommandés

kant_ein

bryce

kant_ein

bryce

kant_ein

kant_ein

bryce

kant_ein

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante