additionner la longueur de plusieurs lignes ou polylignes

[laura]

Salut,

 

j'ai des métrés à effectuer et j'aimerais bien avoir quelques pistes pour faire une routine qui reconnaîtrait toutes les polylignes (ou lignes si c'est plus simple) d'un même calque et additonnerait chaque segment de droite ...

 

merci.

 

 

[Aviglémy]

Bonjour !

j'ai un exemple de lisp qui additionne les longueur de polyligne.

 

(defun c:cumlperi ()
 (prompt "\nPerimètre multiple>>Saisir une ou plusieurs polylignes:")
 (setq js1 (ssget))
 (setq njs (sslength js1) ijs 0 l_perim '())
 (while (< ijs njs)
    (setq no1 (ssname js1 ijs))
    (command "aire" "o" no1)
    (setq v_perim (getvar "perimeter"))
    (if (null v_perim) (write-line "Erreur dans la saisie des entités!!") (setq l_perim (cons v_perim l_perim)))
    (setq ijs (1+ ijs))
  )
  (if (null l_perim) (write-line "Aucune action réalisée!!") (progn
     (if (null tprec) (setq tprec "2"))
     (setq tres (getstring (strcat "\Précision du résultat<" tprec ">:")))
     (if (not (eq tres "")) (setq tprec tres))
     (setq vprec (read tprec)) 
     (setq t_perim (strcat (rtos (apply '+ l_perim) 2 vprec) " Ml"))
     (setq pot (getpoint "\nSaisir point d'insertion!!"))
     (command "texte" pot "" "" t_perim)
)))
(princ "\nTaper cumlperim pour lancer la commande....")
(print) 

 

Dis moi si ca correspond a ta recherche....:D

[(gile)]

Salut,

 

Vite fait en compilant quelques routines de ma boite à outils :

 

;;; Retourne la valeur du code dxf

(defun val_dxf (code ent)
 (cdr (assoc code (entget ent)))
)

;;; LONGOBJT Retourne la longueur ou le périmètre d'un objet (ename)

(defun LONGOBJT	(objt)
 (cond
   ((= (val_dxf 0 objt) "LINE")
    (distance (val_dxf 10 objt) (val_dxf 11 objt))
   )
   ((= (val_dxf 0 objt) "ARC")
    (* (ANGARC objt) (val_dxf 40 objt))
   )
   ((member (val_dxf 0 objt)
     '("CIRCLE" "ELLIPSE" "LWPOLYLINE" "SPLINE")
    )
    (command "_area" "_object" objt)
    (getvar "perimeter")
   )
   ((= (type (car objt)) 'ENAME)
    (princ "\nLa longueur de cet objet n'est pas définie.")
   )
 )
)

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

(defun c:long_line (/ clq js cnt tot)
 (if
   (setq
     clq (entsel "\nSélectionnez un objet sur le calque ou : ")
   )
    (setq clq (val_dxf 8 (car clq)))
    (setq clq (getstring "\nNom du calque: "))
 )
 (if (tblsearch "LAYER" clq)
   (progn
     (setq js	(ssget "_X" (list (cons 0 "LINE,LWPOLYLINE") (cons 8 clq)))
    cnt	0
    tot	0.0
     )
     (repeat (sslength js)
(setq tot (+ tot (LONGOBJT (ssname js cnt)))
      cnt (1+ cnt)
)
     )
     (princ (strcat (itoa cnt)
	     " entités mesurées \nLongueur totale :"
	     (rtos tot)
     )
     )
   )
   (princ "\nNom de calque invalide.")
 )
 (princ)
)

 

Il faut charger les 3 routines et taper long_line pour lancer la commande.

 

PS : tel quel, les longueurs des arcs des polylignes seront mesurées aussi. On pourrait ajouter les cercles, les arcs, les ellipses et les splines simplement en modifiant le filtre de sélection.[Edité le 20/12/2005 par (gile)]

 

PS2 : Si on ajoute les arcs au filtre de séléction il faudra aussi charger cette routine :

;;; ANGARC Retourne l'angle décrit par un arc de cercle.

(defun ANGARC (arc / ang)
 (setq ang (- (val_dxf 51 arc) (val_dxf 50 arc)))
 (if (minusp ang)
   (setq ang (+ (* 2 pi) ang))
 )
 ang
)

 

[Edité le 20/12/2005 par (gile)]

[zebulon_]

salut (gile)

 

tu pourrais remplacer ta defun longobjt par quelque chose de ce style

 

(setq ent (car (entsel "\nSélectionner objet : ")))

 (setq
     vlaobj (vlax-ename->vla-object ent)
     pt_org (vlax-curve-getStartPoint vlaobj)
     pt_end (vlax-curve-getEndPoint vlaobj)
     param_start (vlax-curve-getStartParam vlaobj)
     param_end (vlax-curve-getEndParam vlaobj)
     perim_obj (vlax-curve-getDistAtParam vlaobj param_end)
 )

 

en récupérant la valeur de perim_obj. L'avantage c'est que ça marche quel que soit le type d'objet et qu'on n'a pas à se colletiner une série de cond.

 

Amicalement

 

Zebulon_

 

[(gile)]

Merci Zebulon_

 

J'ai ressorti cette routine que j'avais faite avant de connaître la moindre fonction en VisualLISP.

 

De plus, les StartParam et EndParam restent assez obscurs pour moi, ils ne correspondent pas à la même chose suivant les entités, mais je vais essayer de creuser un peu la chose.

 

D'autre part, si le VisualLISP est plus pratique et parfois incontournable pour récupérer et modifier les propriétés des objets, je suis plus à l'aise avec AutoLISP qui a aussi l'avantage d'être presque entièrement compatible avec les logiciel IntelliDesk/IntelliCad.

[Tramber]

Les Param sont attribués par AutoCAD et on ne peut les controler.

 

Le mieux c'est encore vla-get-length sur poly, ligne ou spline et vla-get-arclength sur arc. Pourquoi se casser la binette ?

[(gile)]

Suite à la remarque fort pertinente de Zebulon_ et par la même pour répondre à Tramber, on peut remplacer la routine "longobjt" plus haut, par celle ci, beaucoup plus concise :

 

;;; LONGOBJT Retourne la longueur ou le périmètre d'un objet (ename)

(defun LONGOBJT	(ent)
 (vl-load-com)
 (vlax-curve-getDistAtParam
   (vlax-ename->vla-object ent)
   (vlax-curve-getEndParam
     (vlax-ename->vla-object ent)
   )
 )
)

[Tramber]

C'est bien la première fois que je vois une utilité à Param. C'est pas mal, mais bon , c'est juste pour éviter les arcs.....ouais,ok.

[(gile)]

Tu as raison Tramber, pour ce sujet ci, où il n'est question que de lignes et poly le plus concis serait :

(defun LONGOBJT	(ent)
 (vl-load-com)
 (vla-get-length (vlax-ename->vla-object ent))
)

 

Mais je suis content d'avoir trouvé la méthode avec Param, elle marche aussi pour les longueurs des arcs et les périmètres des cercles et des ellipses.

J'aime bien avoir des sous-routines polyvalentes de ce style pour m'en servir dans d'autres.

Celle là je vais la garder, avec un controle des erreurs, genre :

(defun VL-LONGOBJT (ent / l)
 (vl-load-com)
 (setq	l (vl-catch-all-apply
    'vlax-curve-getDistAtParam
    (list (vlax-ename->vla-object ent)
	  (vlax-curve-getEndParam
	    (vlax-ename->vla-object ent)
	  )
    )
  )
 )
 (if (vl-catch-all-error-p l)
   (vl-catch-all-error-message l)
   l
 )
)

[autospeed]

Les fonctions MLC ( métré des lignes par calques ) et MPC ( métré des polylignes par calques ) du logiciel Autospeed http://www.autospeed.biz permet de faire exactement ce que tu désires et en pus , les résultats sont exportés dans un tableau excel.

Voir les démo en ligne sur le site http://www.autospeed.biz

[(gile)]

Une version un peu plus aboutie.

 

On peut choisir le calque en sélectionnant un objet sur ce calque ou faire "ENTER" et taper le nom du calque (çà marche sur les calques gelés)

 

Les résultats sont donnés dans la fenêtre AutoCAD et peuvent être enregistrées dans un fichier Excel.

 

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

;;; Retourne la valeur du code dxf

(defun val_dxf (code ent)
 (cdr (assoc code (entget ent)))
)

;;; LONGOBJT Retourne la longueur ou le périmètre d'un objet (ename)

(defun LONGOBJT	(ent)
 (vl-load-com)
 (vla-get-length (vlax-ename->vla-object ent))
)

;;; Fonction principale

(defun c:long_line (/ clq js cnt tot nb_l nb_pl lo_l lo_pl)
 (if
   (setq
     clq (entsel "\nSélectionnez un objet sur le calque ou : ")
   )
    (setq clq (val_dxf 8 (car clq)))
    (setq clq (getstring "\nNom du calque: "))
 )
 (if (tblsearch "LAYER" clq)
   (progn
     (setq js	  (ssget "_X" (list '(0 . "LINE,LWPOLYLINE") (cons 8 clq)))
    nb_l  0
    nb_pl 0
    lo_l  0.0
    lo_pl 0.0
     )
     (repeat (sslength js)
(setq ent (ssname js (+ nb_l nb_pl)))
(cond
  ((= (val_dxf 0 ent) "LINE")
   (setq nb_l (1+ nb_l)
	 lo_l (+ lo_l (LONGOBJT ent))
   )
  )
  ((= (val_dxf 0 ent) "LWPOLYLINE")
   (setq nb_pl (1+ nb_pl)
	 lo_pl (+ lo_pl (LONGOBJT ent))
   )
  )
)
     )
     (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] : "
     )
     "Oui"
  )
(progn
  (setq
    file
     (open
       (getfiled "Créez ou sélectionnez un fichier" "" "xls" 33)
       "a"
     )
  )
  (princ descr file)
  (close file)
)
     )
     (graphscr)
   )
   (princ "\nNom de calque invalide.")
 )
 (princ)
)

 

[Edité le 21/12/2005 par (gile)]

[laura]

merci à tous pour vos réponses.

à première vue, celle de (gile) me semble la plus appropriée tant que ça reste du autolisp, sinon c'est encore plus du chinois pour moi si je me lance maintenant dans visualisp...

je vais tester tout ça et bon appétit à tous...

 

merci

[Patrick_35]

Salut

Tu as aussi ce sujet

 

@+

[autospeed]

La version de demo d'autospeed ( version totalement gratuite et noon limitée dans le temps ) donne un acces complet aux outils de métré MPC et MLC.

Il te suffit simplement de coller tes polylignes ou tes lignes dans le dessin autospeed.dwg fourni avec puis de taper mlc ou mpc

Comme le nom de tes calques sera différent de ceux du dessin Autospeed.dwg , tu n'auras aucun mal a les sélectionner puis a les importer sous excel.

Phil auteur de http://www.autospeed.biz

[(gile)]

À Patrick_35

 

À quoi sert le (setq deb (vlax-curve-getStartParam sel)) ?

 

Pour DistAtParam, EndParam semble suffisant ?

[Patrick_35]

Si je souhaite par exemple trouver la moitié de mon objet, un (vlax-curve-getDistAtParam sel (/ (- fin deb) 2)) suffit

 

@+

[(gile)]

OK, je ne pensais qu'à la longueur totale.

[excalibur]

Bonjour,

 

Sur le Lisp de Aviglémy, pourriez-vous m'indiquer la manière d'obtenir le résultat multiplié par un rapport ?

 

Je m'explique, je dessine en centimètres et je voudrais avoir le résultat en mètres.

 

Merci d'avance pour vos réponses.

[bonuscad]

Bonjour,

 

Sur le Lisp de Aviglémy, pourriez-vous m'indiquer la manière d'obtenir le résultat multiplié par un rapport ?

 

Je m'explique, je dessine en centimètres et je voudrais avoir le résultat en mètres.

 

Merci d'avance pour vos réponses.

 

Au plus réduit..., tu pourrais faire ceci:

changer

(setq t_perim (strcat (rtos (apply '+ l_perim) 2 vprec) " Ml"))

 

par

     (setq factor (getreal "\nFacteur multiplicatif? <1>: "))
     (if (not factor) (setq factor 1.0))
     (setq t_perim (strcat (rtos (* factor (apply '+ l_perim)) 2 vprec) " Ml"))

[excalibur]

Merci bonuscad pour ta réponse.

 

Encore une dernière demande : comment agrandir le texte du résultat ?

[lecrabe]

Hello

 

Juste une idée en passant... Tu essayes de changer la valeur de la variable TEXTSIZE avant d'executer la routine Lisp ?!

 

Bye, lecrabe

[excalibur]

J'ai trouvé.

 

Sur la ligne suivante : (command "texte" pot "" "" t_perim)

 

Les premiers "" correspondent à la taille du texte et les deuxièmes "" à l'angle.

[ahbv]

Bonjour a tous,

est ce qu'il serait possible de compter aussi les polylignes dans les blocs normaux et blocs dynamiques (j'utilise souvent le lisp longt.lsp qui fonctionne a merveille mais losrque je dois metrer des polylignes dans des blocs (surtout dynamiques) il faut que je les explose et j'ai tres souvent des mauvaises surprises !!).

merci d'avance (et bravo pour vos lisp)

 

Une version un peu plus aboutie.

 

 

On peut choisir le calque en sélectionnant un objet sur ce calque ou faire "ENTER" et taper le nom du calque (çà marche sur les calques gelés)

 

 

Les résultats sont donnés dans la fenêtre AutoCAD et peuvent être enregistrées dans un fichier Excel.

 

 

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


;;; Retourne la valeur du code dxf


(defun val_dxf (code ent)

 (cdr (assoc code (entget ent)))

)


;;; LONGOBJT Retourne la longueur ou le périmètre d'un objet (ename)


(defun LONGOBJT	(ent)

 (vl-load-com)

 (vla-get-length (vlax-ename->vla-object ent))

)


;;; Fonction principale


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

 (if

   (setq

     clq (entsel "\nSélectionnez un objet sur le calque ou < Nom >: ")

   )

    (setq clq (val_dxf 8 (car clq)))

    (setq clq (getstring "\nNom du calque: "))

 )

 (if (tblsearch "LAYER" clq)

   (progn

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

    nb_l  0

    nb_pl 0

    lo_l  0.0

    lo_pl 0.0

     )

     (repeat (sslength js)

(setq ent (ssname js (+ nb_l nb_pl)))

(cond

  ((= (val_dxf 0 ent) "LINE")

   (setq nb_l (1+ nb_l)

	 lo_l (+ lo_l (LONGOBJT ent))

   )

  )

  ((= (val_dxf 0 ent) "LWPOLYLINE")

   (setq nb_pl (1+ nb_pl)

	 lo_pl (+ lo_pl (LONGOBJT ent))

   )

  )

)

     )

     (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"

     )

  )

  (princ descr file)

  (close file)

)

     )

     (graphscr)

   )

   (princ "\nNom de calque invalide.")

 )

 (princ)

)

 

<font class=edite>[Edité le 21/12/2005 par (gile)]</font>