mise en place des données d\'un métré sur excel

[charlie69]

Salut a tous,

 

voici un programme de métré. 3 cas sont possibles que l'on sélectionne à l'aide d'une boite de dialogue:

 

- métré des ligne et polylignes

- métré des surfaces prédéfinies (surface déjà tracé)

- métré des surfaces non définies (que l'on dessine en lancant le programme)

 

Pour le "métré des ligne et polylignes" les données sont enregistré sur excel. Mais pour le métré des surfaces je n'arrive pas à enregistrer les surfaces sur excel. Pouvez m'aider? merci.

 

Je vous ai mis la boite de dialogue et le programme.

 

Metre : dialog {label="Métré pour les lignes, polylignes et surfaces";

 

:column {

spacer_1;

 

:radio_column {

:radio_button {label="Lignes et polylignes"; key=cas0; value = "0";}

:radio_button {label="Surfaces prédéfinies"; key=cas1; value = "0";}

:radio_button {label="Surfaces non définies"; key=cas2; value = "0";}

}

spacer_1;

}

:row {ok_cancel;}

}

 

 

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Boite DCL ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

 

(defun c:metre_ligne_surfaces ()

(setq dcl_id (load_dialog "Boite de dialogue métré.dcl"))

(if (not (new_dialog "Metre" dcl_id))

(exit)

)

 

(action_tile "cas0" "(setq cas \"0\")")

(action_tile "cas1" "(setq cas \"1\")")

(action_tile "cas2" "(setq cas \"2\")")

 

(action_tile "accept" "(done_dialog 1)")

(action_tile "cancel" "(done_dialog 0)")

 

 

(setq ok (start_dialog))

(unload_dialog dcl_id)

 

(metre)

(princ)

)

 

 

(defun metre ()

 

(setq cas (atoi cas))

 

(cond

((= cas 0)

(progn

;;; 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 long_line (/ clq js cnt tot nb_l nb_pl lo_l lo_pl)

 

(setq pt '(0 0))

 

 

(setq Nom_calque (strcat "Nom du calque"))

(setq Nombre_lignes (strcat "Nombre de lignes"))

(setq Longueur_ligne (strcat "Longueur de ligne"))

(setq Nombre_polylignes (strcat "Nombre de polylignes"))

(setq Longueur_polyligne (strcat "Longueur de polyligne"))

(setq Longueur_totale (strcat "Longueur totale"))

(setq descr (strcat

Nom_calque "\t" Nombre_lignes

"\t" Longueur_ligne "\t"

Nombre_polylignes "\t"

Longueur_polyligne "\t"

Longueur_totale "\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)

)

)

 

(while Pt

 

(setq pt nil)

(if

(setq

clq

(entsel

"\nSélectionnez un objet sur le calque : "

; ou < Nom >

)

)

 

 

 

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

(setq clq1

(getstring "\nNom du calque : ")

)

)

(setq pt (cadr clq))

(if (tblsearch "LAYER" clq1)

(progn

(setq js (ssget "_X"

(list '(0 . "LINE,LWPOLYLINE") (cons 8 clq1))

)

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"

;clq1

;"Nombre de lignes.......\t"

;(itoa nb_l)

;"Longueur de ligne......\t"

;(rtos lo_l)

;"Nombre de polylignes...\t"

;(itoa nb_pl)

;"Longueur de polyligne..\t"

;(rtos lo_pl)

;"Longueur totale........\t"

;(rtos (+ lo_l lo_pl))

 

clq1

"\t"

(itoa nb_l)

"\t"

(rtos lo_l)

"\t"

(itoa nb_pl)

"\t"

(rtos lo_pl)

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

 

) ;fin while

)

)

 

;;;)

 

;-------------

 

 

 

((= cas 2) ;surfaces non définies

(progn

;;;(defun c:aires()

(setq a (getvar "osmode"))

(setvar "osmode" 0)

(setvar "cmdecho" 0)

(command "ortho" "in")

(command "echltp" "1")

(command "-calque" "et" "surface_non_def"

"co" "blanc" "" "tl"

"continuous" "" ""

)

(Prompt

"\nCliquer le contour de votre aire "

)

(terpri)

(setq pt (getpoint "\nPoint d'origine:"))

(command "polylign" pt "la" 0 0)

(while pt

(setq pt (getpoint "\nPoint suivant (return pour FIN): "))

(command pt)

)

;;; (setq xg 0)

;;; (setq yg 0)

;;; (setq nc 0)

;;; (setq n 0)

;;; (setq nom (entlast))

;;; (setq lt (entget nom))

;;; (setq len (length lt))

;;; (repeat len

;;; (setq e1 (car (nth n lt)))

;;; (if (= e1 10)

;;; (progn

;;; (setq xg (+ xg (cadr (nth n lt))))

;;; (setq yg (+ yg (caddr (nth n lt))))

;;; (setq nc (1+ nc))

;;; )

;;; )

;;; (setq n (1+ n))

;;; )

;;; (setq p1 (list (/ xg nc) (/ yg nc)))

(setq txt (getstring "\nEntrer votre texte:"))

(command "aire" "O" (entlast))

(setq surfa (getvar "area"))

(setq surfa (rtos surfa 2 2))

(princ "\nSurface totale en m²: ")

(princ surfa)

(setq txt1 (strcat "surface: " surfa " m²"))

(command "texte" "m" pause 1 0 txt)

(command "texte" "" txt1)

(command "redess")

(princ)

)

)

;;; )

 

 

;--------------

 

 

((= cas 1) ;surfaces prédéfinies

(progn

;;; (defun c:surface ( / gr txt cont)

(setvar "cmdecho" 0)

(command "calque" "et" "surface_predef" "co" "7" "" "")

(prompt "\nChoisir les polylignes ....")

(setq gr (ssget))

(setq surfa1 0

cont 0

)

(repeat (sslength gr)

(command "_area" "_o" (ssname gr cont))

(setq surfa1 (+ surfa1 (getvar "area")))

(setq cont (+ 1 cont))

)

(setq surfa1 (rtos surfa1 2 2))

(princ "\nSurface totale en m²: ")

(princ surfa1)

(setq txt2 (getstring "\nEntrer votre texte:"))

(setq txt3 (strcat "surface: " surfa1 " m²"))

(command "texte" "m" pause 1 0 txt2)

(command "texte" "" txt3)

(princ)

 

 

 

; calcul des surfaces prédéfinies et insertion dans un tableau excel

 

; Retourne la valeur du code dxf

 

(defun val_dxf1 (code1 ent1)

(cdr (assoc code1 (entget ent1)))

)

 

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

 

(defun LONGOBJT1 (ent1)

(vl-load-com)

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

)

 

;Fonction principale

 

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

 

(setq pt1 '(0 0))

 

 

(setq Nom_calque1 (strcat "Nom du calque"))

(setq Nombre_surface (strcat "Nombre de surfaces"))

(setq surface_totale (strcat "Surface totale"))

 

 

 

(setq descr1 (strcat

Nom_calque "\t" Nombre_surface

"\t" surface_totale "\n"

)

)

(textscr)

(princ descr1)

(initget "Oui Non")

(if (= (getkword

"\nEnregistrer dans un fichier ? : "

;[Oui/Non] < Non >

)

"Oui"

)

(progn

(setq

file1

(open

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

"a"

)

)

(princ descr1 file1)

(close file1)

)

)

 

(while Pt1

 

(setq pt1 nil)

(if

(setq

clq2

(entsel

"\nSélectionnez un objet sur le calque : "

; ou < Nom >

)

)

 

 

 

(setq clq3 (val_dxf1 8 (car clq2)))

(setq

clq3 (getstring "\nNom du calque : ")

)

)

(setq pt1 (cadr clq2))

(if (tblsearch "LAYER" clq3)

(progn

(setq js1 (ssget "_X"

(list '(0 . "LINE LWPOLYLINE") (cons 8 clq3))

)

nb_s 0

s_t 0.0

)

(repeat (sslength js1)

(setq ent1 (ssname js1 (+ nb_s s_t)))

(cond

((= (val_dxf1 0 ent1) "LINE")

(setq nb_s (1+ nb_s)

s_t (+ s_t (LONGOBJT1 ent1))

)

)

((= (val_dxf1 0 ent1) "LWPOLYLINE")

(setq nb_s (1+ nb_s)

s_t (+ s_t (LONGOBJT1 ent1))

)

)

)

)

 

(setq descr1 (strcat

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

;clq1

;"Nombre de lignes.......\t"

;(itoa nb_l)

;"Longueur de ligne......\t"

;(rtos lo_l)

;"Nombre de polylignes...\t"

;(itoa nb_pl)

;"Longueur de polyligne..\t"

;(rtos lo_pl)

;"Longueur totale........\t"

;(rtos (+ lo_l lo_pl))

 

clq3

"\t"

(itoa nb_s)

"\t"

(rtos s_t)

"\n"

 

)

)

 

(textscr)

(princ descr1)

(initget "Oui Non")

(if

(= (getkword

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

)

"Oui"

)

(progn

(setq

file1

(open

(getfiled "Créez ou sélectionnez un fichier"

""

"xls"

33

)

"a"

)

)

(princ descr1 file1)

(close file1)

)

)

(graphscr)

)

(princ "\nNom de calque invalide.")

)

(princ)

 

) ;fin while

)

)

;;; )

 

)

)

 

 

Charlie69

[(gile)]

Salut,

 

Même pour moi, qui reconnais la plupart des lignes de code de ce LISP, il demeure très pénible à lire et, à fortiori, à corriger.

Si tu veux avoir de l'aide, et tu en auras certainement, il ne faut pas décourrager ceux qui seraient suceptibles de te la donner.

 

Commence donc par faire un gros ménage :

 

- supprime les nombreuses lignes inutiles, par exemple, plutôt que :

(setq Nom_calque (strcat "Nom du calque"))
(setq Nombre_lignes (strcat "Nombre de lignes"))
(setq Longueur_ligne (strcat "Longueur de ligne"))
(setq Nombre_polylignes (strcat "Nombre de polylignes"))
(setq Longueur_polyligne (strcat "Longueur de polyligne"))
(setq Longueur_totale (strcat "Longueur totale"))
(setq descr (strcat
Nom_calque "\t" Nombre_lignes
"\t" Longueur_ligne "\t"
Nombre_polylignes "\t"
Longueur_polyligne "\t"
Longueur_totale "\n"
)
) 

écrit simplement :

(setq descr
      "Nom du calque\tNombre de lignes\tLongueur de ligne\tNombre de polylignes\tLongueur de polyligne\tLongueur totale\n"
      ) 

 

- évite les répétitions en ne conservant à l'intérieur du (cond...) que ce qui est spécifique à chaque condition ; mets avant le (cond ...) ce qui est nécessaire à plusieurs conditions (choix du calque, par exemple) et après le (cond ...) les expressions communes en fonction du résutat des condition (ex : choix du fichier et inscription de 'descr' dans ce fichier).

 

Au final ton code devrait être facilement 2 à 3 fois moins long et beaucoup plus clair.