Surface/Perimetre de N polylignes

[lecrabe]

 

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"

 

[julien51]

Salut,

 

Je pense que tu peux utilisé celui la qui est apparament très bien:

http://www.delicad.com/autocad/npl.htm mais je n'ai pas pu l'essayer car il ne fonctionne pas avec autocad 2007.

Moi j'ai utilisé celui la qui permet de paramaetre quelque truc :

http://www.delicad.com/autocad/activeline.htm

 

Mais attention ils sont limité à 15 utilisations aprés il faut acheté une license.

 

Julien

[Bred]

Salut,

es-tu allez voir dans les lisp de Patrick_35 ?

Je pense que le lisp REA devrait répondre (en partie) à tes besoins...

[lecrabe]

 

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)

 

[(gile)]

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

[(gile)]

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