Aller au contenu

Surface/Perimetre de N polylignes


Messages recommandés

Posté(e)

 

Hello

 

J'ai trouvé des routines qui écrivent la surface et/ou le périmètre/longueur d'un objet graphique par exemple une polyligne ...

 

Mais ce que je cherche, c'est une routine qui écrivent automatiquement la surface ou le périmètre/longueur de N Polylignes / LWPolylignes automatiquement avec un éventuel préfixe / suffixe et en demandant le nombre de décimales (utilisation de RTOS)

 

Exemple de sortie: 13 / 12.50 / Surf = 12.50 m² / Long : 13 m / etc

 

Pour une certaine "souplesse", la position où sera généré le texte est "critique" :

- soit au point de départ

- soit au dernier point (= point de départ si la polyligne est close)

- soit au 2eme point

- soit au milieu du 1er segment (entre le 1er et le 2ème point)

 

MAP ou CIVIL font tout ça très bien à travers une requête ou étiquette dynamique !

 

Mais beaucoup de gens ont simplement un bon vieil AutoCAD (2004-2008) !

 

Le Decapode "AutoCADant"

 

Autodesk Expert Elite Team

Posté(e)

 

Hello

 

Je connais REA et aussi les champs dynamiques mais malheureusement

cela ne me convient pas du tout ! :exclam:

 

Et je n'ai pas du tout trouvé mon bonheur sur le Web ... :casstet:

 

C'est pourquoi j'ai proposé ce mini-CCTP et je pense que cela peut servir

à de nombreuses personnes :)

 

En effet le TOP, ce serait une option supplémentaire qui proposerait éventuellement NON pas de faire des textes simples mais plutôt des champs dynamiques !

 

Cependant je ne suis pas un fanatique des champs dynamiques pour des raisons de performances (sur des milliers d'objets) et aussi pour des raisons encore plus importantes d'inter-opérabilité entre de multiples versions différentes d'AutoCAD / LT / MAP / CIVIL / A D T / Autres logiciels de DAO / etc :(

 

Le Decapode (Multi-versions : LT / ACAD / MAP / etc)

 

Autodesk Expert Elite Team

Posté(e)

Salut,

 

Un premier jet : 3 versions pour l'insertion du texte.

Avec les champs dynamiques, j'avais fait parcelle

 

EDIT: Réparé un rechercher/remplacer malheureux dans les 3 routines

 

;; Texte inséré sur le premier sommet
(defun c:LongSurfPline (/ ad sp ts lp pl sl dl pa sa da ht)
 (vl-load-com)
 (setq	ad (vla-get-ActiveDocument (vlax-get-acad-object))
sp (if (= (getvar "CVPORT") 1)
	(vla-get-Paperspace ad)
	(vla-get-Modelspace ad)
      )
ts    (getvar "TEXTSIZE")
lp    (getvar "LUPREC")
pl    (getstring T
		 "\nEntrez le préfixe pour les longueurs ou : "
      )
sl    (getstring T
		 "\nEntrez le suffixe pour les longueurs ou : "
      )
dl    (getint
	(strcat	"\nEntrez le nombre de décimales pour les longueurs 			(itoa lp)
		">: "
	)
      )
pa    (getstring T
		 "\nEntrez le préfixe pour les surfaces ou : "
      )
sa    (getstring T
		 "\nEntrez le suffixe pour les surfaces ou : "
      )
da    (getint
	(strcat	"\nEntrez le nombre de décimales pour les surfaces 			(itoa lp)
		">: "
	)
      )
 )
 (or (setq ht (getdist
	 (strcat "\nSpécifiez la hauteur de texte : ")
       )
     )
     (setq ht ts)
 )
 (foreach d '(dl da) (or (eval d) (set d lp)))
 (vla-StartUndoMark ad)
 (if (ssget '((0 . "LWPOLYLINE")))
   (vlax-for o	(vla-get-ActiveSelectionSet ad)
     (vla-addText
sp
(strcat	pl
	(rtos (vla-get-Length o) 2 dl)
	sl
	" / "
	pa
	(rtos (vla-get-Area o) 2 da)
	sa
)
(vlax-3d-point (vlax-curve-getStartPoint o))
ht
     )
   )
 )
 (vla-EndUndoMark ad)
 (princ)
)

 

 

;; Texte centré sur le centre de gravité
(defun c:LongSurfPline (/ ad sp ts lp pl sl dl pa sa da ht ip tx)
 (vl-load-com)
 (setq	ad (vla-get-ActiveDocument (vlax-get-acad-object))
sp (if (= (getvar "CVPORT") 1)
	(vla-get-Paperspace ad)
	(vla-get-Modelspace ad)
      )
ts    (getvar "TEXTSIZE")
lp    (getvar "LUPREC")
pl    (getstring T
		 "\nEntrez le préfixe pour les longueurs ou : "
      )
sl    (getstring T
		 "\nEntrez le suffixe pour les longueurs ou : "
      )
dl    (getint
	(strcat	"\nEntrez le nombre de décimales pour les longueurs 			(itoa lp)
		">: "
	)
      )
pa    (getstring T
		 "\nEntrez le préfixe pour les surfaces ou : "
      )
sa    (getstring T
		 "\nEntrez le suffixe pour les surfaces ou : "
      )
da    (getint
	(strcat	"\nEntrez le nombre de décimales pour les surfaces 			(itoa lp)
		">: "
	)
      )
 )
 (or (setq ht (getdist
	 (strcat "\nSpécifiez la hauteur de texte : ")
       )
     )
     (setq ht ts)
 )
 (foreach d '(dl da) (or (eval d) (set d lp)))
 (vla-StartUndoMark ad)
 (if (ssget '((0 . "LWPOLYLINE")))
   (vlax-for o	(vla-get-ActiveSelectionSet ad)
     
     (mapcar 'vla-delete rg)
   )
 )
 (vla-EndUndoMark ad)
 (princ)
)

 

 

;; Texte centré sur le centre de gravité et ligne de rappel jusqu'au premier sommet
(defun c:LongSurfPline (/ ad sp ts lp pl sl dl pa sa da ht ip tx)
 (vl-load-com)
 (setq	ad (vla-get-ActiveDocument (vlax-get-acad-object))
sp (if (= (getvar "CVPORT") 1)
	(vla-get-Paperspace ad)
	(vla-get-Modelspace ad)
      )
ts    (getvar "TEXTSIZE")
lp    (getvar "LUPREC")
pl    (getstring T
		 "\nEntrez le préfixe pour les longueurs ou : "
      )
sl    (getstring T
		 "\nEntrez le suffixe pour les longueurs ou : "
      )
dl    (getint
	(strcat	"\nEntrez le nombre de décimales pour les longueurs 			(itoa lp)
		">: "
	)
      )
pa    (getstring T
		 "\nEntrez le préfixe pour les surfaces ou : "
      )
sa    (getstring T
		 "\nEntrez le suffixe pour les surfaces ou : "
      )
da    (getint
	(strcat	"\nEntrez le nombre de décimales pour les surfaces 			(itoa lp)
		">: "
	)
      )
 )
 (or (setq ht (getdist
	 (strcat "\nSpécifiez la hauteur de texte : ")
       )
     )
     (setq ht ts)
 )
 (foreach d '(dl da) (or (eval d) (set d lp)))
 (vla-StartUndoMark ad)
 (if (ssget '((0 . "LWPOLYLINE")))
   (vlax-for o	(vla-get-ActiveSelectionSet ad)
     (setq rg (vlax-invoke sp 'addRegion (list o))
    ip (trans (vlax-get (car rg) 'Centroid) 1 0)
    tx (vla-addText
	 sp
	 (strcat pl
		 (rtos (vla-get-Length o) 2 dl)
		 sl
		 " / "
		 pa
		 (rtos (vla-get-Area o) 2 da)
		 sa
	 )
	 (vlax-3d-point '(0 0 0))
	 ht
       )
     )
     (vla-put-Alignment tx acAlignmentMiddleCenter)
     (vla-put-TextAlignmentPoint tx (vlax-3d-point ip))
     (vla-addLine
sp
(vla-get-InsertionPoint tx)
(vlax-3d-point (vlax-curve-getStartPoint o))
     )
     (mapcar 'vla-delete rg)
   )
 )
 (vla-EndUndoMark ad)
 (princ)
) 

 

[Edité le 21/7/2007 par (gile)]

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

Posté(e)

J'ai réparé une erreur qui empêchait les 3 routines ci-dessus de fonctionner.

 

Voici une autre version qui fonctionne avec des champs dynamiques.

 

Je suis toujours très indécis en ce qui concerne le point d'insertion du texte dans la polyligne.

 

;; Texte centré sur le centre de gravité et ligne de rappel jusqu'au premier sommet
;; Champs dynamiques
(defun c:LongSurfPline (/ ad sp ts lp pl sl dl pa sa da ht ip tx)
 (vl-load-com)
 (setq	ad (vla-get-ActiveDocument (vlax-get-acad-object))
sp (if (= (getvar "CVPORT") 1)
	(vla-get-PaperSpace ad)
	(vla-get-ModelSpace ad)
      )
ts    (getvar "TEXTSIZE")
lp    (getvar "LUPREC")
pl    (getstring T
		 "\nEntrez le préfixe pour les longueurs ou : "
      )
sl    (getstring T
		 "\nEntrez le suffixe pour les longueurs ou : "
      )
dl    (getint
	(strcat	"\nEntrez le nombre de décimales pour les longueurs 			(itoa lp)
		">: "
	)
      )
pa    (getstring T
		 "\nEntrez le préfixe pour les surfaces ou : "
      )
sa    (getstring T
		 "\nEntrez le suffixe pour les surfaces ou : "
      )
da    (getint
	(strcat	"\nEntrez le nombre de décimales pour les surfaces 			(itoa lp)
		">: "
	)
      )
 )
 (if (setq ht
     (getdist
       (strcat "\nSpécifiez la hauteur de texte : ")
     )
     )
   (setvar "TEXTSIZE" ht)
   (setq ht ts)
 )
 (foreach d '(dl da) (or (eval d) (set d lp)))
 (vla-StartUndoMark ad)
 (if (ssget '((0 . "LWPOLYLINE")))
   (vlax-for o	(vla-get-ActiveSelectionSet ad)
     (setq rg (vlax-invoke sp 'addRegion (list o))
    ip (trans (vlax-get (car rg) 'Centroid) 1 0)
    id (itoa (vla-get-ObjectID o))
     )
     (vla-addLine
sp
(vlax-3d-point ip)
(vlax-3d-point (vlax-curve-getStartPoint o))
     )
     (setq tx (vla-addMText
	 sp
	 (vlax-3d-point '(0 0 0))
	 ht
	 (strcat "%			 id
		 ">%).Length \\f \"%lu2%pr"
		 (itoa dl)
		 (if (= pl sl "")
		   ""
		   (strcat "%ps[" pl "," sl "]")
		 )
		 "\">%\n"
		 "%			 id
		 ">%).Area \\f \"%lu2%pr"
		 (itoa da)
		 (if (= pa sa "")
		   ""
		   (strcat "%ps[" pa "," sa "]")
		 )
		 "\">%"
	 )
       )
     )
     (vla-put-Width tx 0.0)
     (vla-put-BackgroundFill tx :vlax-true)
     (vla-put-AttachmentPoint tx acAttachmentPointMiddleCenter)
     (vla-Move tx (vla-get-InsertionPoint tx) (vlax-3d-point ip))
     (mapcar 'vla-delete rg)
   )
 )
 (vla-EndUndoMark ad)
 (princ)
) 

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

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é