Aire d\'une polyligne

[Invité Sylvainhinard]

Bonjour,

 

Tout d'abord bonne année... J'aimerais bien me faire un petit lisp qui coterai automatiquement des surfaces de polylignes . Toutefois je n'arrive pas à obtenir la surface de ma polyligne:

Solution 1 :

 

Je me sert de (entget(car(entsel))) toutefois je n'ai pas trouvé la valeur qui correspond à ma surface

 

Solution 2:

 

Je me sers de (setq b (command "aire" "ob")) mais quand je fais un (princ b) Autocad me retourne NIL

 

A l'aide SVP

 

P.S. : Je me met aussi au VBA, si vous avez la solution pour le LISP et le VBA faites m'en part

 

Merci Beaucoup

 

Sylvain

 

 

[Patrick_35]

Salut et tous mes voeux de bonheur et de santé pour la nouvelle année

 

Avec la commande aire ou avec les fonctions visual lisp

Dans le style

(vl-load-com)
(setq ent (vlax-ename->vla-object (car (entsel)))) ; transforme l'entité en objet visual
(vla-get-area ent) ; retourne l'aire

 

@+

[zebulon_]

Salut,

 

la solution d'utiliser la commande aire d'autocad est tout à fait exploitable. Il faut juste savoir que lorsqu'on a exécuté la commande aire, elle renseigne automatiquement 2 variables autocad : perimeter et area dont il suffit de récupérer les valeurs avec une commande getvar.

 

(commande "aire" "ob" pause)

(setq A (getvar "AREA"))

(setq P (getvar "PERIMETER"))

 

;)

[didier]

bonsoir

pour compléter le message de Patrick_35,

je me permets de vous mettre en garde

sur le fait qu'une SURFACE est renvoyée

même si la polyligne n'est pas close

donc il me paraît judicieux d'avertir l'utilisateur

par le test suivant :

(setq test (vla-get-closed ent))

(if test

(alert "Polyligne close")

(alert "Polyligne ouverte")

)

 

amicalement

[Serge]

Patrick_135,

Dans ta signature, tu devrais peut-être écrire (1934-2003) ;-)

 

Sylvain,

Voici une routine que j'ai laissée sur l'autre forum. C'est un bon point de départ.

 

;;; C:LONGAIRE

;;; Retourne la longueur et l'aire totale d'un jeu d'objets parmi:

;;; ligne, polyligne de toute sorte, arc, cercle, ellipse, spline et mline

;;;

;;; Compatibilité: AutoCAD 2002 et plus

;;;

;;; Instructions:

;;; 1) Charger ce fichier

;;; 2) Tapez LONGAIRE sur la ligne de commande

;;; 3) Choisissez des objets. Les objets invalides sont filtrés.

;;;

;;; Modifications:

;;; 2004/12/24 : Compatibilité avec 2002

;;; 2004/12/28 : Traitement des Mline et exclusion des xline.

;;; 2004/12/30 : Correction pour version française.

;;;

;;; Par Serge Camiré, CadNovation, 2004/12/30

;;; http://www.cadnovation.com/fr

;;;

 

(defun c:longaire (

/ AireTotale ename i LongueurTotale n ss vlaObject wasOldPolyline

)

(vl-load-com)

(if (< (atoi (getvar "acadver")) 15)

(progn

(alert "Ce programme n'est compatible qu'à partir de la version 2000")

(exit)

))

 

(princ "\nChoisissez des objets à mesurer: ")

(setq ss (ssget (list (cons 0 "*polyline,arc,circle,ellipse,line,mline"))))

(if ss

(progn

(setq AireTotale 0.0)

(setq LongueurTotale 0.0)

(setq i 0 n (sslength ss))

(while (< i n)

(setq ename (ssname ss i))

(setq wasOldPolyline nil)

(setq wasOldPolyline (convertOldPolyline ename)) ; Si retourne T, un nouvel objet a été créé

(setq vlaObject (vlax-ename->vla-object ename))

(setq LongueurTotale (+ LongueurTotale (getObjectLength vlaObject)))

(setq AireTotale (+ AireTotale (getObjectArea vlaObject)))

(if wasOldPolyline (undoConvert))

(setq i (1+ i))

)

(princ (strcat "\nLa longueur totale est: " (rtos LongueurTotale)))

(princ (strcat "\tL'aire totale est: " (rtos AireTotale)))

))

(princ)

)

 

(defun undoConvert ()

(command "_u")

(princ)

)

 

(defun convertOldPolyline (

ename

/ return

)

(setq return nil)

(if (and (= (atoi (getvar "acadver")) 15) (= 'ENAME (type ename)) (= (cdr (assoc 0 (entget ename))) "POLYLINE"))

(progn

(command "_convert" "_polyline" "_select" ename "" )

(if (= (cdr (assoc 0 (entget ename))) "LWPOLYLINE") (setq return t))

))

return

)

 

 

;;; getObjectLength

;;; Retourne la longueur d'un objet

;;; Reçoit un objet Vla d'une ligne, polyligne de toute sorte, arc, cercle, ellipse, spline.

;;; Retourne un Real

(defun getObjectLength (

vlaObject

/ coordinates flagBit71 i isClosed n points3D return version15

)

(setq version15 (= (atoi (getvar "acadver")) 15))

(cond

;; Spline et Ellipse sont des NURBS

((wcmatch (vla-get-ObjectName vlaObject) "AcDbSpline,AcDbEllipse")

(setq return (vlax-curve-getDistAtParam vlaObject (vlax-curve-getEndParam vlaObject)))

)

 

;; Arcs

((wcmatch (vla-get-ObjectName vlaObject) "AcDbArc")

(setq return (vla-get-ArcLength vlaObject))

)

 

;; Cercles

((wcmatch (vla-get-ObjectName vlaObject) "AcDbCircle")

(setq return (vla-get-Circumference vlaObject))

)

 

;; Line

((wcmatch (vla-get-ObjectName vlaObject) "AcDbLine")

(setq return (vla-get-Length vlaObject))

)

 

;; Mline

((wcmatch (vla-get-ObjectName vlaObject) "AcDbMline")

(setq coordinates (safearray-value (variant-value (vla-get-coordinates vlaObject))))

(setq points3D nil)

(while coordinates

(setq points3D (append points3D (list (list (car coordinates) (cadr coordinates) (caddr coordinates)))))

(setq coordinates (cdddr coordinates))

)

 

;; Il n'existe pas d'interface pour savoir si l'objet est ouivert ou fermé !!!

(setq flagBit71 (cdr (assoc 71 (entget (vlax-vla-object->ename vlaObject)))))

(setq isClosed (= 2 (boole 1 flagBit71 2)))

;; Ajouter le premier point à la suite si le mline est fermé.

(if isClosed (setq points3D (reverse (cons (car points3D) (reverse points3D)))))

 

(setq return 0)

(setq i 0 n (1- (length points3D)))

(while (< i n)

(setq return (+ return (distance (nth i points3D) (nth (1+ i) points3D))))

(setq i (1+ i))

)

)

 

;; LightweightPolyline, Polyline, 3dPolyline (à faire en dernier)

((wcmatch (vla-get-ObjectName vlaObject) "AcDbPolyline,AcDb2dPolyline,AcDb3dPolyline")

(setq return (if version15

(vlax-curve-getDistAtParam vlaObject (vlax-curve-getEndParam vlaObject)) ; R15

(vla-get-Length vlaObject) ; R16 et +

))

)

 

;; MVPort

((wcmatch (vla-get-ObjectName vlaObject) "*mvport*")

(setq return 0.0) ; Pub

)

 

(t (setq return 0.0)) ; Type inconnu

)

return

)

 

 

;;; getObjectArea

;;; Retourne l'aire d'un objet

;;; Reçoit un objet Vla d'une ligne, polyligne de toute sorte, arc, cercle, ellipse, spline.

;;; Retourne un Real

(defun getObjectArea (

vlaObject

/ coordinates oldOsmode points3D return

)

(cond

;; Spline et Ellipse sont des NURBS

((wcmatch (vla-get-ObjectName vlaObject) "AcDbSpline,AcDbEllipse")

(setq return (vlax-curve-getArea vlaObject))

)

 

;; Arcs

((wcmatch (vla-get-ObjectName vlaObject) "AcDbArc")

(setq return (vla-get-Area vlaObject))

)

 

;; Cercles

((wcmatch (vla-get-ObjectName vlaObject) "AcDbCircle")

(setq return (vla-get-Area vlaObject))

)

 

;; Line

((wcmatch (vla-get-ObjectName vlaObject) "AcDbLine")

(setq return 0.0)

)

 

;; Mline

((wcmatch (vla-get-ObjectName vlaObject) "AcDbMline")

(setq coordinates (safearray-value (variant-value (vla-get-coordinates vlaObject))))

(setq points3D nil)

(while coordinates

(setq points3D (append points3D (list (list (car coordinates) (cadr coordinates) (caddr coordinates)))))

(setq coordinates (cdddr coordinates))

)

(setvar "nomutt" 1) ; Attention : à usage restraint. Enlève totalement l'écho.

(setq oldOsmode (getvar "osmode"))

(setvar "osmode" 0) ; Pas de modes d'accrochage

(command "_area")

(foreach point3D points3D (command point3D))

(command "")

(setvar "osmode" oldOsmode)

(setvar "nomutt" 0)

(setq return (getvar "area"))

)

 

;; LightweightPolyline, Polyline

((wcmatch (vla-get-ObjectName vlaObject) "AcDbPolyline,AcDb2dPolyline")

(setq return (vla-get-Area vlaObject))

)

 

;; MVPort

((wcmatch (vla-get-ObjectName vlaObject) "*mvport*")

(setq return 0.0) ; Pub

)

 

(t (setq return 0.0)) ; Type inconnu

)

return

)

 

(princ "\nTapez LONGAIRE pour connaitre la longueur et l'aire totale d'un jeu d'objets.")

(princ)

 

 

Serge

[Invité Sylvainhinard]

Bonjour,

 

Je tient à tous vous remercier, comme d'habitude vos réponse correponde tout à fait à mes attente. Serge : J'ai hate de tester ton Lisp; je cherchais justement un programme permettant de faire des metres .

 

@Bientot

 

Sylvain

[Patrick_35]

Pour Serge

C'est exact, je ne savais pas qu'il était décédé le 16 juin 2003 à Montréal. Donc je change ma signature pour une nouvelle pensée

 

Pour Didier

Ton test ne fonctionne pas, il devrait être par exemple

(if (= (vla-get-closed ent) :vlax-true)
(alert "Polyligne Fermée")
(alert "Polyligne Ouverte")
)

 

@+

[barbichette]

Bonjour,

 

Je viens de me faire orienter vers ce post.

 

Merci

 

[Edité le 13/12/2005 par barbichette]

[CADarome]

Pour Serge

C'est exact, je ne savais pas qu'il était décédé le 16 juin 2003 à Montréal. Donc je change ma signature pour une nouvelle pensée

 

Pour Didier

Ton test ne fonctionne pas, il devrait être par exemple

(if (= (vla-get-closed ent) :vlax-true)
(alert "Polyligne Fermée")
(alert "Polyligne Ouverte")
)

 

@+

 

c'est exact Patrick.....

Visual requiere des valeurs Visual..