métré élements

[jacobs33]

Bonjour,

 

quelqu'un a t'il un LISP permetant d'additionner des longeurs des polylignes, arcs, lignes , cercles et splines en fonction d'un claques selectionné .

Merci D'avance

 

;) ;) :)

[p.martin]

Salut voici une petite routine qui répond à ton attente

 

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

 

(defun c:long_line

(/ val_dxf longobjt clq js cnt tot nb_l nb_pl lo_l lo_pl)

 

;; Retourne la valeur du code dxf

(defun val_dxf (code ent)

(cdr (assoc code (entget ent)))

)

 

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

(defun LONGOBJT (ent)

(vl-load-com)

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

)

 

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

)

 

 

[jacobs33]

Salut et merci,

 

J'ai bien essayé de le modifier pour qu'il addition aussi les arcs et les splines.

mais je n'y suis pas parvenu peu tu m'aider.

"je vais quand continuer mes recherches".

 

 

 

:D :D

[(gile)]

Salut,

 

(defun c:long-obj (/ lay ss n n-a l-a n-c l-c n-l l-l n-p l-p n-s l-s descr file)
 (if (setq lay	(car
	  (entsel "\nSélectionnez un objet sur le calque à traiter: ")
	)
     )
   (if	(setq ss (ssget	"_X"
		(list '(0 . "ARC,CIRCLE,LINE,LWPOLYLINE,SPLINE")
		      (assoc 8 (entget lay))
		)
	 )
)
     (progn
(foreach n '("a" "c" "l" "p" "s")
  (set (read (strcat "n-" n)) 0)
  (set (read (strcat "l-" n)) 0.0)
)
(repeat	(setq n (sslength ss))
  (setq	ent (ssname ss (setq n (1- n)))
	typ (cdr (assoc 0 (entget ent)))
	len (vlax-curve-getDistAtParam
	      ent
	      (vlax-curve-getEndParam ent)
	    )
  )
  (cond
    ((= typ "ARC")
     (setq n-a (1+ n-a)
	   l-a (+ len l-a)
     )
    )
    ((= typ "CIRCLE")
     (setq n-c (1+ n-c)
	   l-c (+ len l-c)
     )
    )
    ((= typ "LINE")
     (setq n-l (1+ n-l)
	   l-l (+ len l-l)
     )
    )
    ((= typ "LWPOLYLINE")
     (setq n-p (1+ n-p)
	   l-p (+ len l-p)
     )
    )
    ((= typ "SPLINE")
     (setq n-s (1+ n-s)
	   l-s (+ len l-s)
     )
    )
  )
)
(setq descr (strcat
	      "\nCalque\t" (cdr (assoc 8 (entget lay)))
	      "\nType d'objet\tN\tLongueur"
	      "\nArc.........\t"(itoa n-a) "\t" (rtos l-a)
	      "\nCercle......\t"(itoa n-c) "\t" (rtos l-c)
	      "\nLigne.......\t"(itoa n-l) "\t" (rtos l-l)
	      "\nPolyligne...\t"(itoa n-p) "\t" (rtos l-p)
	      "\nSpline......\t"(itoa n-s) "\t" (rtos l-s)
	    )
)
(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)
) 

[lili2006]

Re,

 

(gile), même requête que sur un autre post récent, que dois-je rajouter sur ton lisp (et surtout ou ?) pour avoir les distances en "m" sachant que je dessine en EO en cm ??

 

Merci d'avance.

 

PS : Tou est ok !

 

Calque BAC TRACE

Type d'objet N Longueur

Arc......... 1 5106.83

Cercle...... 1 10884.63

Ligne....... 118 47606.87

Polyligne... 151 490332.51

Spline...... 1 9184.1

Enregistrer dans un fichier ? [Oui/Non] : o

Commande:

[(gile)]

Il suffit de diviser la longueur par 100

 

Ajoute , avant le (cond ...)

 

(setq len (/ len 100.0))

[lili2006]

Rere,

 

Cet échange est devenu du temps réel,...

 

Merci encore (gile)

 

[jacobs33]

Salut,

 

Merci à tous pour votre soutien et votre rapidité de réaction "comme d'habitude".

Je me suis permis de rajouter quelques ligne ( basic vu non niveau )qui renvoie les totaux et et de modifier la valeur des longueur en fonction de l'unité de travail.

 

(defun c:long-obj (/	 lay   ss    n	   n-a	 l-a   n-c   l-c
	   n-l	 l-l   n-p   l-p   n-s	 l-s   l-t   n-t
	   descr file
	  )
 (if (setq lay
     (car
       (entsel "\nSélectionnez un objet sur le calque à traiter: ")
     )
     )
   (if	(setq ss (ssget	"_X"
		(list '(0 . "ARC,CIRCLE,LINE,LWPOLYLINE,SPLINE")
		      (assoc 8 (entget lay))
		)
	 )
)
     (progn
(foreach n '("a" "c" "l" "p" "s")
  (set (read (strcat "n-" n)) 0)
  (set (read (strcat "l-" n)) 0.0)
)
(repeat	(setq n (sslength ss))
  (setq	ent (ssname ss (setq n (1- n)))
	typ (cdr (assoc 0 (entget ent)))
	len (/ (vlax-curve-getDistAtParam
		 ent
		 (vlax-curve-getEndParam ent)
	       )
	       10   ;;Valeur à modifier qui permet de renvoyer des métres en fonction de l'unité dessin 
	    )
  )
  (cond
    ((= typ "ARC")
     (setq n-a (1+ n-a)
	   l-a (+ len l-a)
     )
    )
    ((= typ "CIRCLE")
     (setq n-c (1+ n-c)
	   l-c (+ len l-c)
     )
    )
    ((= typ "LINE")
     (setq n-l (1+ n-l)
	   l-l (+ len l-l)
     )
    )
    ((= typ "LWPOLYLINE")
     (setq n-p (1+ n-p)
	   l-p (+ len l-p)
     )
    )
    ((= typ "SPLINE")
     (setq n-s (1+ n-s)
	   l-s (+ len l-s)
     )
    )
  )
)
(Setq 
      n-t (+ n-a n-c n-l n-p n-s)l-t (+ l-a l-c l-l l-p l-s)
)
(setq descr (strcat
	      "\nCalque\t"
	      (cdr (assoc 8 (entget lay)))
	      "\nType d'objet\tN\tLongueur"
	      "\nArc.........\t"
	      (itoa n-a)
	      "\t"
	      (rtos l-a)
	      "\nCercle......\t"
	      (itoa n-c)
	      "\t"
	      (rtos l-c)
	      "\nLigne.......\t"
	      (itoa n-l)
	      "\t"
	      (rtos l-l)
	      "\nPolyligne...\t"
	      (itoa n-p)
	      "\t"
	      (rtos l-p)
	      "\nSpline......\t"
	      (itoa n-s)
	      "\t"
	      (rtos l-s)
	      "\ntotal.......\t"
	      (itoa n-t)
	      "\t"
	      (rtos l-t)
	    )
)
(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)
)

[lili2006]

Bonjour à toutes et tous,

 

jacobs33, pas mal non plus,...

 

Par contre, je pense qu'il y a un soucis dans les unités car j'ai fait un test sur une spline dessinée en cm dans l'EO qui mesure 70.4 m réel et ton Lisp me renvoi 704 m ??!!

 

PS: Format => Controle des unités => cm => ok !

[etienne.leb-appac]

bonjour,

étant donné que je n'y connait rien en programmation, je voudrai savoir s'il est possible de modifier ce LISP afin qu'il mesure la longueur de cylindre en fonction de leur diamètre et de leur calques ???

 

merci d'avance