compteur

[JUJUZAZA]

Bonjour,

 

le programme ci-dessous ne fonctionne plus, au lancement de la commande j'ai ce message :

 

; erreur : erreur automation problème lors de chargement de vba.

 

le programme fonctionnait sous la version autocad 2009 mais plus sous la version 2013.

c'est un compteur avec option.

 

 

voici le programme , j'aimerai le rendre fonctionnel , merci d'avance :

 

 

 

(defun c:HORLOGE(/ js bllst ent HORLOGE nb InputBox)

 

(defun InputBox (Titre Message Defaut / users1 valeur)

(setq users1 (getvar "users1"))

(acad-push-dbmod)

(vla-eval (vlax-get-acad-object) (strcat "ThisDrawing.SetVariable \"USERS1\"," "InputBox (\"" Message "\", \"" Titre "\", \"" Defaut "\")"))

(setq valeur (getvar "users1"))

(setvar "users1" users1)

(acad-pop-dbmod)

valeur

)

 

(if (not (eq (setq js (InputBox "Décompte de blocs" "Veuillez donnez un nom de bloc ou * pour tous" "*")) ""))

(if (setq js (ssget (list (cons 0 "INSERT") (cons 2 js))))

(progn

(setq nb 0)

(while (setq ent (ssname js nb))

(setq ent (vlax-ename->vla-object ent))

(if (not (vlax-property-available-p )

(setq HORLOGE (append HORLOGE (list (vla-get- ent)))

(setq HORLOGE (append HORLOGE (list (vla-get- ent)))

)

)

(setq nb (1+ nb))

)

(setq HORLOGE (acad_strlsort HORLOGE))

(while (setq ent (car HORLOGE))

(setq nb (length HORLOGE)

HORLOGE (vl-remove ent HORLOGE)

bllst (append bllst (list (cons ent (- nb (length HORLOGE))))))

)

(mapcar '(lambda (x) (princ (strcat "\n- " (itoa (cdr x)) " bloc(s) " (car x)))) bllst)

)

)

)

(princ)

[Patrick_35]

Salut

 

Tu fais appel à une fonction vba dans le lisp, or vba n'est plus intégré par défaut dans Autocad.

A installer suivant ce lien ou écrire une nouvelle fonction évitant l'appel à vba.

 

Par exemple

;-------------------------------------------------------------------------
; Saisir une valeur via une boite de dialogue
;-------------------------------------------------------------------------

 ;; InputBox (gile)
 ;; Ouvre une boite de dialogue pour récupérer une valeur
 ;; sous forme de chaine de caractère
 ;;
 ;; Arguments
 ;; tous les arguments sont de chaines de caractère (ou "")
 ;; box : titre de la boite de dialogue
 ;; msg : message d'invite
 ;; val : valeur par défaut
 ;;
 ;; Retour
 ;; une chaine ("" si annulation)
 ;;
 ;; Modifié par Patrick_35 pour inclure le caractère \n
 ;; comme retour chariot

(defun InputBox (box msg val / subr temp file dcl_id ret)
   ;; Retour chariot automatique à 50 caractères
   (defun subr (str / pos)
     (cond
((setq pos (vl-string-search "\n" str))
  (strcat ":text_part{label=\""
	  (substr str 1 pos)
	  "\";}"
	  (subr (substr str (+ 2 pos)))
  )
)
((and (< 80 (strlen str))
      (setq pos (vl-string-position 32 (substr str 1 80) nil T))
  )
  (strcat ":text_part{label=\""
	  (substr str 1 pos)
	  "\";}"
	  (subr (substr str (+ 2 pos)))
  )
)
(T
  (strcat ":text_part{label=\"" str "\";}")
)
     )
   )
   ;; Créer un fichier DCL temporaire
   (setq temp (vl-filename-mktemp "Tmp.dcl")
  file (open temp "w")
  ret  ""
   )
   ;; Ecrire le fichier
   (write-line
     (strcat
"InputBox:dialog{key=\"box\";initial_focus=\"val\";spacer;:paragraph{"
(subr msg)
"}spacer;:edit_box{key=\"val\";edit_width=54;allow_accept=true;}
spacer;ok_cancel;}"
     )
     file
   )
   (close file)
   ;; Ouvrir la boite de dialogue
   (setq dcl_id (load_dialog temp))
   (if (not (new_dialog "InputBox" dcl_id))	
     (exit)
   )
   (set_tile "box" box)
   (set_tile "val" val)
   (action_tile
     "accept"
     "(setq ret (get_tile \"val\")) (done_dialog)"
   )
   (start_dialog)
   (unload_dialog dcl_id)
   ;;Supprimer le fichier
   (vl-file-delete temp)
   ret
 )

(inputbox "Titre" "Message" "Valeur par défaut")

 

@+

[JUJUZAZA]

salut patrick_35

 

je te remercie pour le lien , l'installation s'est bien déroulée même si le fichier est en anglais.

le programme d'origine fonctionne parfaitement. ;)

 

le code que t'as joint est à remplacer ou à intégrer au code de base (avec vba) ? :huh:

 

te remerciant.

[Patrick_35]

C'est pour remplacer une partie du code qui contient l'appel à une fonction vba si vba n'est pas installé.

 

La partie du code à remplacer

(defun InputBox (Titre Message Defaut / users1 valeur)
(setq users1 (getvar "users1"))
(acad-push-dbmod)
(vla-eval (vlax-get-acad-object) (strcat "ThisDrawing.SetVariable \"USERS1\"," "InputBox (\"" Message "\", \"" Titre "\", \"" Defaut "\")"))
(setq valeur (getvar "users1"))
(setvar "users1" users1)
(acad-pop-dbmod)
valeur
)

 

@+