Lisp avec intégration excel

[David64]

Bonjour à tous et merci par avance aux personnes qui prendront le temps de me répondre,

 

Je souhaitais récupéré les valeurs de textes dans autocad pour les intégrer dans excel et je suis tombé (encore) sur un lisp développé par le regretté Patrick. Le lisp fonctionne parfaitement mais je souhaitais l'adapter, actuellement le lisp récupère les valeurs dans un classeur vierge qu'il ouvre lui même, j'aurai souhaité qu'elles soient intégrées dans un fichier bien défini, dans une feuille bien définie et dans une cellule bien définie. J'ai bien tenté de réadapter le code mais mes connaissances en lisp sont beaucoup trop limitées... c'est pourquoi je m'en remets au forum.

Je vous joins ci-dessous le lisp, merci par avance.

 

(defun c:dwgxls(/ cla cel feu lig sel wks xl

MsgBox UnFormat)

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

; Afficher un message via une boite de dialogue

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

(defun MsgBox (Titre Bouttons Message / Reponse WshShell)

(acad-push-dbmod)

(setq WshShell (vlax-create-object "WScript.Shell"))

(setq Reponse (vlax-invoke WshShell 'Popup Message 0 Titre (itoa Bouttons)))

(vlax-release-object WshShell)

(acad-pop-dbmod)

Reponse

)

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

; Récuperer la valeur String d'un Mtext

; Extrait du lisp de Custom Stuff StripMtext v3.07

; http://www.users.qwest.net/~sdoman/

; Modifié par Patrick_35 pour correction d'un bug+formattage des caractères spéciaux

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

(defun UnFormat (Mtext Formats / All Format1 Format2 Format3 Pos Text Str)

(and

Mtext

Formats

(= (type Mtext) 'STR)

(= (type Formats) 'STR)

(setq Formats (strcase Formats))

(setq Text "")

(setq All T)

(if (= Formats "*")

(setq Formats "S"

Format1 "\\[LO`~]"

Format2 "\\[ACFHQTW]"

Format3 "\\P"

)

(progn

(setq Format1 "" Format2 "" Format3 "")

(foreach item '("L" "O" "~")

(if (vl-string-search item Formats)

(setq Format1 (strcat Format1 "`" item))

(setq All nil)

)

)

(if (= Format1 "")

(setq Format1 nil)

(setq Format1 (strcat "\\[" Format1 "]"))

)

(foreach item '("A" "C" "F" "H" "Q" "T" "W")

(if (vl-string-search item Formats)

(setq Format2 (strcat Format2 item))

(setq All nil)

)

)

(if (= Format2 "")

(setq Format2 nil)

(setq Format2 (strcat "\\[" Format2 "]"))

)

(if (vl-string-search "P" Formats)

(setq Format3 "\\P")

(setq Format3 nil All nil)

)

T

)

)

(while (/= Mtext "")

(cond

((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\{}]")

(setq Mtext (substr Mtext 3)

Text (strcat Text Str)

)

)

((and All (wcmatch (substr Mtext 1 1) "[{}]"))

(setq Mtext (substr Mtext 2))

)

((and Format1 (wcmatch (strcase (substr Mtext 1 2)) Format1))

(setq Mtext (substr Mtext 3))

)

((and Format2 (wcmatch (strcase (substr Mtext 1 2)) Format2))

(setq Mtext (substr Mtext (+ 2 (if (vl-string-search ";" Mtext)(vl-string-search ";" Mtext) 0))))

)

((and Format3 (wcmatch (strcase (substr Mtext 1 2)) Format3))

(if

(or

(= " " (substr Text (if (zerop (strlen Text)) 1 (strlen Text))))

(= " " (substr Mtext 3 1))

)

(setq Mtext (substr Mtext 3))

(setq Mtext (substr Mtext 3) Text (strcat Text " "))

)

)

((and (vl-string-search "S" Formats)(wcmatch (strcase (substr Mtext 1 2)) "\\S"))

(setq Str (substr Mtext 3 (- (vl-string-search ";" Mtext) 2))

Text (strcat Text (vl-string-translate "#^\\" "/^\\" Str))

Mtext (substr Mtext (+ 4 (strlen Str)))

)

)

(1

(setq Text (strcat Text (substr Mtext 1 1))

Mtext (substr Mtext 2)

)

)

)

)

)

(while (setq Pos (vl-string-search "\\U+" Text))

(setq Str (substr Text (1+ pos) 7)

Text (vl-string-subst (chr (hexdec (substr Str 4))) Str Text)

)

)

(vl-string-trim " " Text)

)

(if (setq xl (vlax-get-or-create-object "Excel.Application"))

(if (ssget (list (cons 0 "TEXT,MTEXT")))

(progn

(setq wks (vlax-get xl 'Workbooks)

cla (vlax-invoke wks 'add)

feu (vlax-get cla 'activesheet)

lig 1

)

(vla-put-visible xl :vlax-true)

(princ)

(vlax-for ent (setq sel (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))

(setq cel (vlax-get-property feu 'range (strcat "A" (itoa lig)))

lig (1+ lig)

)

(vlax-put cel 'value2 (unformat (vla-get-textstring ent) "*"))

)

(vla-delete sel)

(foreach sel (list xl wks cla feu cel)

(vlax-release-object sel)

)

(setq xl nil wks nil cal nil feu nil cel nil)

(gc)(gc)

)

)

(msgbox "TXL" 16 "Excel n'a pas été installé.")

)

(princ)

)
 

 

DWGXLS.lsp

[DenisHen]

Salut.

Connais-tu l'excellent "Lxl.lsp" ?

Il te donne l'accès direct à un XLS...

Cordialement.

Denis...