Métré

[mattttth23]

Salut a tous!

Voila j'ai fais un programme lisp pr coter des lignes, polylignes (avec les bases d'un lisp trouvé ici même) que j'ai arrangé + 2 progammes de surface, tous ça lié avec une boite de dialogue!

La ou je coince c'est pour mettre mes resultats de surface dans le même fichier excel que celui créé pr le 1er programme (ligne et polyligne)

Je c'est pas si c'est très clair mais si quelqu'un a une idée ! je laisse mon programme la!

 

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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 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 m2: ")

(princ surfa)

(setq txt1 (strcat "surface: " surfa " m2"))

(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 m2: ")

(princ surfa1)

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

(setq txt3 (strcat "surface: " surfa1 " m2"))

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

(command "texte" "" txt3)

(princ)

)

)

;;; )

 

 

)

)

 

Merci @+