Aller au contenu

métré élements


jacobs33

Messages recommandés

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)

)

 

 

Lien vers le commentaire
Partager sur d’autres sites

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

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Lien vers le commentaire
Partager sur d’autres sites

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:

Civil 3D 2024 - COVADIS_18.2

https://www.linkedin...3%ABt-95313341/

Lien vers le commentaire
Partager sur d’autres sites

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

Lien vers le commentaire
Partager sur d’autres sites

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 !

Civil 3D 2024 - COVADIS_18.2

https://www.linkedin...3%ABt-95313341/

Lien vers le commentaire
Partager sur d’autres sites

  • 1 an après...

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

« J'ai claqué beaucoup d'argent dans l'alcool, les filles et les voitures de sport - le reste, je l'ai gaspillé »

http://www.appac-caen.com

Lien vers le commentaire
Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité