Aller au contenu

centroid d\'une polyligne fermée


Messages recommandés

Posté(e)

Bonjour,

 

Je m'acharne à essayer de mettre un point dans le centroid d'une polyligne fermée, sans succés.

 

Le problème que j'ai en fait c'est que la fonction centroid ne fonctione pas pour les polyligne mais uniquement pour les régions.

 

ainsi j'essaie de transformer ma polyligne en région, de calculer le centroid et d'ajouter le point et d'effacer ma region...

 

C'est facile à dire...

 

mais je n'arrive pas à creer ma region à partir d'une polyligne fermée dont le nombre de cotés varie d'une polyligne à l'autre :P ...

 

 

Merci pour toute idée

 

 

 

Invité Patrick
Posté(e)

Ben...et la commande REGION, elle fait pas ça?

Posté(e)

J'ai essayé mais la commande Addregion fonctione avec pour argument les objets suivants :

 

Line, Arc, Circle, Elliptical Arc, LightweightPolyline, Spline.

 

Mes objets sont des AcadPolylignes, d'ailleurs j'ignore ce que sont des LightweightPolyline et la différence avec des Acadpolylines....

 

Sinon c'est vrai que la commande Addregion serait ideal.. pour chaque plolyline fermée je pourrait creer une région...

 

Merci en tout cas.

 

Xavier

 

 

 

 

Posté(e)

re bonjour

je te prie de m'excuser,

mais je n'avais pas fait attention que tu parlais de VBA,

ma solution est valable à la ligne de commande

dans un VBA, j'ai pas fait encore de centroïd.

si tu continues à sécher, fais moi signe.

on se mettra à deux pour chercher une solution.

ciao

 

  • 2 ans après...
Posté(e)

Bonjour à tous.

 

Je suis intéressé pas l'option centroid car je dois l'inclure dans une routine de calcul de surface. Dans ma routine (Voir forum VBA-routine "Calcul de surface" 24-08-06) je clique sur la polyligne dont je doit calculer l'aire puis je clique sur un point dinserton pour qu'apparaisse un texte contenant l'aire. En fait j'aimerai en un clik que le texte s'insère au milieu de la polyligne, d'où mon intêret pour le centroid.

 

Si vous avez un lien...

 

Merci d'avance.

"La ligne droite est le plus court chemin entre deux points, à condition que les deux points soient bien en face l'un de l'autre" P. Desproges.

Posté(e)

Bonjour à tous,

 

J'ai retrouvé celà dans mes sauvegardes !

 

Il y a un sujet également en vlisp avec des polylignes converties en région !

avec des champs aires, sur le forum FR autodesk !

 

Daniel OLIVES

 

 

Option Explicit

 

'

' Ce programme utilise le contour type région pour placer

' en chaque centre de gravité un texte correspondant au numéro du local

' et au dessous le texte correspondant à la surface.

' L001

' 10.0 m2

' Aprés lancement du programme, à la demande de choix des objets

' sélectionner manuellement les objets régions dans l'ordre désirer

' pour la numérotation.

'

'Remarque: L'échelle du dessin est supposée être en mètres (1)

' dans le cas contraire il suffit d'adapter les différents paramètres

'

'

'

'paramètres en dur :

'hauteur de texte CG_RObj_txt_loc = 0.25

'hauteur de texte CG_RObj_txt_surf = 0.25

'décalage entre les deux textes = -0,4

'

'Le 16/02/2003 Daniel Olivès daniel.olives@numericable.fr

'

'Toute amélioration ou remarque est la bienvenue !

'Ce programme est mon premier programme en VBA Autocad, merci d'avance

'de vos conseils à venir !

 

 

 

Sub Main()

Dim RObj As AcadEntity 'Objet région autocad

Dim CG_RObj_txt_loc As AcadText 'Texte Nom du local mis en forme

Dim CG_RObj_txt_surf As AcadText 'Texte Nom de la surface mis en forme

Dim SSObj As AcadSelectionSet 'Jeu de sélection

Dim Centroid As Variant 'centre de gravité CG(centroid)

Dim Nb_RObj As Integer 'Nombre de régions sélectionnées

Dim RObj_txt_loc As String 'Texte nom du local

Dim RObj_txt_surf As String 'Texte surface du local

Dim Location(0 To 2) As Double 'définition du point d'insertion

Dim Aire As Double 'variable surface

Dim Area As AcadEntity 'Objet Surface Autocad

 

 

Randomize Timer

Set SSObj = ThisDrawing.SelectionSets.Add(Str(Rnd))

SSObj.SelectOnScreen

'

Nb_RObj = 1 'initialisation du nombre de régions

For Each RObj In SSObj

If RObj.ObjectName = "AcDbRegion" Then 'Test si l'objet est une région

Aire = RObj.Area 'Récupération de la surface

Centroid = RObj.Centroid 'Récupération du centre de gravité

'

'première ligne de texte centrée au milieu du CG

Location(0) = Centroid(0)

Location(1) = Centroid(1)

RObj_txt_loc = "L" & Format(Nb_RObj, "000") 'Mise en forme N° indice du local Lxxx

Set CG_RObj_txt_loc = ThisDrawing.ModelSpace.AddText(RObj_txt_loc, Location, 0.25) 'Alignement centré au milieu

CG_RObj_txt_loc.Alignment = 10 'Alignement centré au milieu

CG_RObj_txt_loc.TextAlignmentPoint = Location 'ligne obligatoire sinon texte en 0,0,0

'

'deuxième ligne de texte centrée au milieu du CG + décalage en Y de -0.4

Location(0) = Centroid(0)

Location(1) = Centroid(1) - 0.4

RObj_txt_surf = Format(Aire, "## ##0.0") & " m2" 'Mise en forme surface du local x xxx.xx

Set CG_RObj_txt_surf = ThisDrawing.ModelSpace.AddText(RObj_txt_surf, Location, 0.25) 'Alignement centré au milieu

CG_RObj_txt_surf.Alignment = 10 'Alignement centré au milieu

CG_RObj_txt_surf.TextAlignmentPoint = Location 'ligne obligatoire sinon texte en 0,0,0

'ThisDrawing.ModelSpace.AddText "S=" & Aire, Location, 2

'

Nb_RObj = Nb_RObj + 1 'incrémentation du nombre de régions

End If

Next RObj 'région suivante

 

End Sub

 

Posté(e)

Bonjour,

 

Merci tyrese69_ pour ton aide, je vais récupérer le code pour le machouiller un peu et l'arranger à notre sauce. Délais non garantis... Je teste et je reposte...

 

Merci encore... A+

"La ligne droite est le plus court chemin entre deux points, à condition que les deux points soient bien en face l'un de l'autre" P. Desproges.

Posté(e)

Suite de l'histoire...

 

 

Voilà une partie de la routine pour créer la région sur l'objet sélectionné.

 

Sub Region()

 

 

Dim choixOBJ(0) As AcadObject 'C'est l'objet piqué par sélection

 

' Pour piquer l'objet pour la région

 

ThisDrawing.Utility.GetEntity choixOBJ(0), basePnt, "Sélectionnez un objet SVP"

 

 

 

' Create the region

Dim regionObj As Variant

regionObj = ThisDrawing.ModelSpace.AddRegion(choixOBJ)

 

ZoomAll

End Sub

 

 

 

 

Dans mon prochain post, je vous demanderai comment transformer tous les objets d'une collection en région... Je sèche...

 

Merci a vous.

"La ligne droite est le plus court chemin entre deux points, à condition que les deux points soient bien en face l'un de l'autre" P. Desproges.

Posté(e)

Re...

 

Sub Select_SHAB_to_RED_and_region()

 

'Sélection manuelle de tout le dessin et passe la couleur des SHAB en DuCalque et création de région sur les polylignes de la sélectionset

 

' Création du nouveau jeu de sélection

Dim SelectSetSHAB As AcadSelectionSet

Set SelectSetSHAB = ThisDrawing.SelectionSets.Add("NewSelectH")

 

'Parametrage des filtres par calque SHAB et par polyligne

Dim Filtertype(0) As Integer

Dim Filterdata(0) As Variant

 

Filtertype(0) = 8 ' Le 8 est le code DXF des calques

Filterdata(0) = "SHAB" 'Ici on indique quel le calque en question sera le SHAB

 

 

'Selection à l'écran des objets

SelectSetSHAB.SelectOnScreen Filtertype, Filterdata

 

 

SelectSetSHAB.Highlight True 'allume la sélection

 

Dim Polyligneselected As AcadEntity ' Polyligneselected devient une entité

For Each Polyligneselected In SelectSetSHAB 'Tous les objets élus deviennent des entités

Polyligneselected.color = acByLayer 'Les onjets élus changent de couleurs

Next

 

' Create the region-******Les problemes commencent...

 

For Each Polyligneselected In SelectSetSHAB

 

Dim regionObj As Variant

regionObj = ThisDrawing.ModelSpace.AddRegion(SelectSetSHAB)

 

 

Next

 

SelectSetSHAB.Highlight False 'Eteind la sélection

 

 

SelectSetSHAB.Delete 'Vide la sélection

 

 

End Sub

 

 

C'est lors de la création des régions sur les polylignes sélectoinnées que ça ne marche pas... Si qq'un a une idée de ce que l'on met dans :

regionObj = ThisDrawing.ModelSpace.AddRegion(SelectSetSHAB)

car c'est là que le message d'erreur apparaît.

 

On y est presque les gars ! Une fois les régions créées on pourra extraire les centroid pour inserer du texte (Aire et périmètre).

 

A +

 

 

 

 

 

"La ligne droite est le plus court chemin entre deux points, à condition que les deux points soient bien en face l'un de l'autre" P. Desproges.

Posté(e)

C'est encore moi...

 

Didier et Patrick m'ont aiguillé sur les champs dynamiques, ce sont des merveilleuses machines ! Mais cela ne résoud pas le problème des régions pour extraire les périmètres...

Le champs dynamiques doivent être étudiés, c'est incontournable...

 

Allez... zou...

"La ligne droite est le plus court chemin entre deux points, à condition que les deux points soient bien en face l'un de l'autre" P. Desproges.

Posté(e)

Re

Ceci est la part qui gère le champ !

 

(strcat "%<\\AcObjProp Object(%<\\_ObjId "

(itoa id)

">%).Area \\f \"%lu6%qf1 m2>%")

 

C'est la concaténation d'une chaine de caractères

"strcat"

 

%\\AcObjProp Object(%<\\_ObjId

 

l'Id de l'objet

 

et la suite >%).Area\\f\"%lu6%qf1 m2>%"

 

En VBA le strcat ce fait avec des & entre chaque partie !

 

http://discussion.autodesk.com/thread.jspa?threadID=487773

 

Le lien suivant te donne un exemple !

 

Daniel OLIVES

Posté(e)

Salut tous !

 

Je vais passer ton info au peigne fin. Merci pour l'astuce tyrese69_ ! En même temps je fais tout pour éviter le lisp... :casstet: hé hé !

 

A très vite !

"La ligne droite est le plus court chemin entre deux points, à condition que les deux points soient bien en face l'un de l'autre" P. Desproges.

Posté(e)

Désolé, je ne connais pas le VBA, mais je propose un petit LISP (en VisualLISP, plus proche du VBA, il me semble).

 

Il pourrait être un peu plus concis pour être utilisé tel quel, mais j'ai essayé de bien décomposer et de commenter abondamment, si ça peut aider pour une éventuelle traduction en VBA.

 

Il fonctionne avec les polylignes "optimisées" (lwpolyline), donc à utiliser après conversion des polylignes "old style" avec la commande CONVERT (comme indiqué par Didier).

NOTA : si les polylignes 2D ont été lissées ou splinées, la commande CONVERT ne les transformera pas en lwpolylignes. Un LISP (eh oui, encore...) de Bonuscad, ICI, convertit toutes les polylignes 2D en lwpolylignes.

 

Après chargement, taper pt-cen pour lancer la comande.

 

(defun c:pt-cen (/ AcDoc Space SelSet obj Region)

 ;; Pointeur sur le document actif
 (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)))

 ;; Pointeur sur l'espace actif (objet ou papier)
 (if (= (getvar "CVPORT") 1)
   (setq Space (vla-get-PaperSpace AcDoc))
   (setq Space (vla-get-ModelSpace AcDoc))
 )

 ;; Ajout d'un jeu de sélection (vide) à la collection
 (setq
   SelSet (vla-add (vla-get-SelectionSets AcDoc) "Centroid_Sel_Set")
 )

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

 ;; Pour tous les objets contenus dans le jeu de sélection
 (vlax-for obj	SelSet

   ;; Création d'une région
   (setq Region (vlax-invoke Space 'addRegion (list obj)))

   ;; Création d'un point au centre de gravité
   (vlax-invoke
     Space
     'addPoint
     (trans (vlax-safearray->list
       (vlax-variant-value (vla-get-Centroid (car Region)))
     )
     1
     0
     )
   )

   ;; Supression de la région
   (vla-delete (car Region))
 );_ fin de vlax-for

 ;; Suppression du jeu de sélection de la collection
 (vla-delete SelSet)
 (princ)
) 

 

[Edité le 27/8/2006 par (gile)]

  • Upvote 1

Gilles Chanteau - gileCAD - GitHub
Développements sur mesure pour AutoCAD

Posté(e)

Bonsoir !

 

Merci à vous tous pour vos aides, on va potasser tout cela...

"La ligne droite est le plus court chemin entre deux points, à condition que les deux points soient bien en face l'un de l'autre" P. Desproges.

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
×
×
  • 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é