Help longueur polylignes

[bbteddy]

Bonjour

 

Je suis à la recherche d'une commande qui pourrait m'être très utile.

Je souhaite, que dans le meilleur des cas, en sélectionnant plusieurs polylignes Autocad me donne le cumule des longueurs.

 

Merci d'avance.

@+

Stéphane

[fanlou]

Bonjour

Il y a plusieurs solutions, 1 de Gile 1 de Patrick_35 et 2 autres je ne sais plus de qui.

 

De Gile: ;)

;;; C:LONG_LINE (gile)

;;; Calcule la longueur des lignes et lwpolylignes du calque spécifié

 

(defun c:long_line (/ clq js cnt tot nb_l nb_pl lo_l lo_pl)

 

(vl-load-com)

 

(if (and (setq clq (getlayer nil))

(ssget "_X" (list '(0 . "LINE,LWPOLYLINE") (cons 8 clq)))

(setq nb_l 0

nb_pl 0

lo_l 0.0

lo_pl 0.0

)

)

(progn

(vlax-for o (vla-get-ActiveSelectionSet

(vla-get-ActiveDocument (vlax-get-acad-object))

)

(if (= (vla-get-ObjectName o) "AcDbLine")

(setq nb_l (1+ nb_l)

lo_l (+ lo_l (vla-get-Length o))

)

(setq nb_pl (1+ nb_pl)

lo_pl (+ lo_pl (vla-get-Length o))

)

)

)

(setq descr (strcat

"\nNom de calque..........\t"

clq

"\nNombre de lignes.......\t"

(itoa nb_l)

"\nLongueur de ligne......\t"

(rtos lo_l)

"\nNombre de polylignes...\t"

(itoa nb_pl)

"\nLongueur de polyligne..\t"

(rtos lo_pl)

"\nLongueur totale........\t"

(rtos (+ lo_l lo_pl))

"\n"

)

)

(textscr)

(princ descr)

(initget "Oui Non")

(if (= (getkword

"\nEnregistrer dans un fichier ? [Oui/Non] < Non >: "

)

"Oui"

)

(progn

(setq

file

(open

(getfiled "Créez ou sélectionnez un fichier" "" "xls" 33)

"a"

 

De Patrick_35: :)

;;;=================================================================

;;;

;;; MES.LSP V1.00

;;;

;;; Mesurer en continu et avec cumul

;;;

;;; Copyright © Patrick_35

;;;

;;;=================================================================

 

(defun c:mes(/ di pt1 pt2)

(setq pt1 (getpoint "\nPremier Point : ") di 0.0)

(while pt1

(if (setq pt2 (getpoint pt1 "\nPoint suivant : "))

(progn

(setq di (+ di (distance pt1 pt2)))

(princ (strcat "\nDistance mesurée: " (rtos (distance pt1 pt2)) " -- Distance cumulée : " (rtos di)))

)

)

(setq pt1 pt2)

)

(princ)

)

 

(setq nom_lisp "MES")

(if (/= app nil)

(if (= (strcase (substr app (1+ (- (strlen app) (strlen nom_lisp))) (strlen nom_lisp))) nom_lisp)

(princ (strcat "..." nom_lisp " chargé."))

(princ (strcat "\n" nom_lisp ".LSP Chargé.....Tapez " nom_lisp " pour l'éxecuter.")))

(princ (strcat "\n" nom_lisp ".LSP Chargé......Tapez " nom_lisp " pour l'éxecuter.")))

(setq nom_lisp nil)

(princ)

 

et de 3: :cool:

(defun c:LongueurTotal(/ ss tot nb n long obj lst lay l_lay)

(vl-load-com)

(if (setq ss (ssget "_X" '((0 . "LWPOLYLINE"))))

(progn

(setq nb (sslength ss)

n 0

tot 0.0)

(princ

(strcat "\n\nLe dessin contient : " (itoa nb) " polylignes")

)

(repeat nb

(setq obj (vlax-ename->vla-object (ssname ss n))

long (vlax-curve-getDistAtParam

obj

(vlax-curve-getEndParam obj)

)

tot (+ tot long)

lay (vla-get-Layer obj)

)

(princ (strcat "\nP"

(itoa (setq n (1+ n)))

" = "

(rtos long)

"\tCalque : "

lay

)

)

(if (setq l_lay (assoc lay lst))

(setq lst (subst (cons lay (+ long (cdr l_lay))) l_lay lst))

(setq lst (cons (cons lay long) lst))

)

)

(mapcar '(lambda (x)

(princ (strcat "\nLongueur totale sur le calque "

(car x)

" : "

(rtos (cdr x))

)

)

)

lst

)

(princ (strcat "\nLongueur totale dans le dessin = " (rtos tot)))

(textscr)

)

(princ "\nLe dessin ne contient pas de polylignes.")

)

(princ)

)

 

et de 4. :D

(defun c:lg-li-pol (/ LG SEL X)

(setq lg 0

sel nil)

(while (not sel)

(setq sel (ssget (list '(-4 . ""))))

)

(repeat (setq x (sslength sel))

(setq lg (+ lg (vla-get-Length (vlax-ename->vla-object (ssname sel (setq x (1- x)))))))

)

(alert (strcat "Longueur :" (rtos lg) " ."))

(princ)

)

 

Voila de quoi faire. :D

@+

fanfan

[fanlou]

Re-salut

:exclam: heu j´ai répondu un peut vite, fonctionne sur 2006/7 mais je n´ai pas essayez sur 2009, (je ne l´ai pas :( ) donc á essayer.

Bonne journnee.

 

fanfan.

[x_all]

c'est bien le 4 que j'utilise pour faire la somme des longueur sélectionné...

 

en passant

(defun c:sf-pol (/ sf SEL X)
(setq sf 0
sel nil)
(while (not sel)
(setq sel (ssget '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1)))) 
)
(repeat (setq x (sslength sel))
(setq sf (+ sf (vla-get-area (vlax-ename->vla-object (ssname sel (setq x (1- x)))))))
)
(alert (strcat "surface :" (rtos sf) " ."))
(princ)
) 

 

pour faire la somme des surfaces de polylignes fermées sélectionnées

[bbteddy]

Trop cool

 

Merci @ vous

 

je n'arrive pas à faire fonctionner celui de GILE, mais je devrait m'en sortir avec le N°3

 

Merci encore

 

@+

[(gile)]

je n'arrive pas à faire fonctionner celui de GILE

 

Le code a été mal copié (il manque la fin).

Tu trouveras le LISP en téléchargement sur cette page

[fanlou]

re-salut

 

:exclam: Oh ouai, pardon Gille je n´ai pas vérifié (Jsuis C... ou Q... :mad: )

 

@+ fanfan