Métrés sous ACAD

[ACAD666]

Salut,

 

Un petit lisp fait maison (inspiré de lisp existants qd même) qui pour chaque calque, cumule les surfaces des objets du calque, leur longueur et les compte. Puis il met tout ça dans un csv dans le répertoire courant d'autocad.

 

Petit défaut, il n'aime pas les hachures, les calques vides (sauf 0).

 

Très pratique pour faire des métrés à condition de bien dessiner l'article x dans le calque x, de virer les hachures et les xref (à cause des calques vides).

 

Ce sera sûrement ma seule contribution, je n'ai plus d'aspirine :)

 

;				METRE.LSP
;
;	Pour chaque calque du dessin, calcule le nombre d'objets, leur longueur cumulée et leur surface.
;	Le lisp génère un fichier metre.csv dans le répertoire courant d'AutoCAD ou les données sont reportées.
;	Détacher les références externes éventuelles et purger le dessin avant de lancer la commande.



;				DEFINITION FONCTIONS

(defun mtrlines ()
 (setq lbeg (cdr (assoc '10 ent)))
 (setq lend (cdr (assoc '11 ent)))
 (setq llen (distance lbeg lend))
 (setq long (+ long llen))
 (ssdel sn ss1)
)

(defun mtrlarcs ()
(setq cen (cdr (assoc '10 ent)))
(setq rad (cdr (assoc '40 ent)))
(setq dia (* rad 2.0))
(setq circ (* (* rad pi) 2.0))
(setq sang (cdr (assoc '50 ent)))
(setq eang (cdr (assoc '51 ent)))
(if (< eang sang)
 (setq eang (+ eang (* pi 2.0)))
)
(setq tang (- eang sang))
(setq tang2 (* (/ tang pi) 180.0))
(setq circ2 (/ tang2 360.0))
(setq alen (* circ2 circ))
(setq long (+ long alen))
(princ)
(ssdel sn ss1)
)

(defun mtrplines ()
(command "_area" "e" sn)
(setq long (+ long (getvar "perimeter")))
(setq surf (+ surf (getvar "area")))
(ssdel sn ss1)
)

(defun mtrsplines ()
(command "_area" "e" sn)
(setq long (+ long (getvar "perimeter")))
(setq surf (+ surf (getvar "area")))
(ssdel sn ss1)
)

(defun mtrcircles ()
(command "_area" "e" sn)
(setq long (+ long (getvar "perimeter")))
(setq surf (+ surf (getvar "area")))
(ssdel sn ss1)
)

			COMMANDE


(DEFUN C:metre (/ long ss1 sn sn2 et)
(setq cmdecho (getvar "cmdecho"))
(setvar "cmdecho" 0)

(setq file "metre.csv")
(setq ow (open file "w"))
(write-line (strcat "CALQUE"";""SURFACE"";""LONGUEUR"";""NOMBRE") ow)


(setq layinfo (tblnext "layer" T))
(while(setq layinfo (tblnext "layer"))
(setq layname (cdr (assoc '2 layinfo)))

(setq ss1 (ssget "X" (list (cons 8 layname))))
(setq nobj (sslength ss1))
(setq long 0)  
(setq surf 0)


(while (> (sslength ss1) 0)
 (setq sn (ssname ss1 0))
 (setq ent (entget sn))
 (setq et (cdr (assoc '0 ent)))
 (cond
  ((= et "LINE") (mtrlines))
  ((= et "ARC") (mtrlarcs))
  ((= et "LWPOLYLINE") (mtrplines))
  ((= et "POLYLINE") (mtrplines))
  ((= et "SPLINE") (mtrsplines))
  ((= et "CIRCLE") (mtrcircles))
  ((or
    (/= et "LINE")
    (/= et "ARC")
    (/= et "LWPOLYLINE")
    (/= et "POLYLINE")
    (/= et "SPLINE")
    (/= et "CIRCLE")
   )
   (ssdel sn ss1)
  )
 )
)


(write-line (strcat layname";"(rtos surf 2 2)";"(rtos long 2 2)";"(rtos nobj 2 2)) ow)
)
(close ow)
(setvar "cmdecho" cmdecho)
(princ)
)

 

 

[bseb67]

Salut acad666!

 

Je sais que je vais être chiant, mais:

1° utilise la balise code pour poster du code

2° attention à tes variables en lisp: quand une fonction travaille sur une variable, soit tu la passes

en argument soit tu lui donnes un nom nom générique (pas comme ent)

3° pense à protéger en local tes variables utilisées dans la fonction seulement

4° sinon pense à utiliser une variable pour le retour

5° remplace (setq a ...) (setq b ...) par (setq a ... b .... .........)

6° et pour finir quelques commentaires sont toujours la bienvenue

 

 

Mais t'inquiètes, il faut prendre l'habitude et le pli au début, après ca viendra tout seul.

;)

[Patrick_35]

Bonjour

 

Acad666

Ne prend pas ombrage des remarques de bseb67 et merci de tes efforts et de ton partage.

Faire un lisp n'est pas si simple.

Tu as bien débuté et fais le plus dur. Si tu aimes programmer, plusieurs intervenants ici se feront un plaisir de t'aider.

 

@+

[ACAD666]

Heureusement que je l'ai posté dans "débuter en lisp" ! ;)