PB LISP

[nG! Hebus]

Bonjour,

 

J'ai un soucis avec ce lisp de (gile) :

 

;;; INCATT (gile) 03/04/08
;;; Insertions multiple d'un bloc avec incrémentation d'un attribut
;;; La valeur à incrémenter peut être de type numérique, alphabétique,
;;; ou une combinaison alphanumérique.

(defun c:incatt	(/ space name lst tmp file dcl_id scl rot tag val inc pref suff
	 ins)

 (vl-load-com)
 (or *acdoc*
     (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
 )
 (setq	space (if (= (getvar "CVPORT") 1)
	(vla-get-PaperSpace *acdoc*)
	(vla-get-ModelSpace *acdoc*)
      )
 )
 (if (setq name (getblock nil))
   (progn
     (or (tblsearch "BLOCK" name)
  (vla-delete
    (vla-InsertBlock
      space
      (vlax-3d-point '(0 0 0))
      name
      1
      1
      1
      0
    )
  )
     )
     (setq name (vl-filename-base name))
     (vlax-for	e (vla-item (vla-get-Blocks *acdoc*) name)
(if (and
      (= (vla-get-ObjectName e) "AcDbAttributeDefinition")
      (= (vla-get-Constant e) :vlax-false)
    )
  (setq lst (cons (vla-get-TagString e) lst))
)
     )
     (if (setq lst (reverse lst))
(progn
  (setq	tmp  (vl-filename-mktemp "Tmp.dcl")
	file (open tmp "w")
  )
  (write-line
    (strcat
      "incins:dialog{"
      "label=\"Attribut incémenté\";"
      ":boxed_column{"
      "label=\"Bloc\";"
      ":edit_box{"
      "label=\"Echelle globale\";key=\"scl\";edit_width=5;}"
      ":edit_box{"
      "label=\"Rotation\";key=\"rot\";edit_width=5;}} "
      ":boxed_column{"
      "label=\"Attribut\";"
      ":popup_list{"
      "label=\"Etiquette\";key=\"tag\";edit_width=16;}"
      ":edit_box{"
      "label=\"Valeur de départ\";key=\"val\";edit_width=5;allow_accept=true;}"
      ":edit_box{"
      "label=\"Incrément\";key=\"inc\";edit_width=5;allow_accept=true;}"
      ":edit_box{"
      "label=\"Préfixe\";key=\"pref\";edit_width=16;allow_accept=true;}"
      ":edit_box{"
      "label=\"Suffixe\";key=\"suff\";edit_width=16;allow_accept=true;}}"
      "ok_cancel;}"
     )
    file
  )
  (close file)
  (setq	scl    1.0
	rot    0.0
	val    "1"
	inc    1
	pref   ""
	suff   ""
	dcl_id (load_dialog tmp)
  )
  (if (not (new_dialog "incins" dcl_id))
    (exit)
  )
  (start_list "tag")
  (mapcar 'add_list lst)
  (end_list)
  (set_tile "scl" (rtos scl))
  (set_tile "rot" (rtos rot))
  (set_tile "val" val)
  (set_tile "inc" (itoa inc))
  (action_tile
    "scl"
    "(if (and (distof $value)
            (< 0 (distof $value)))
            (setq scl (distof $value))
            (progn
     (alert \"Nécessite un nombre réel strictement positif\")
     (set_tile \"scl\" (rtos scl))
     (mode_tile \"scl\" 2)))"
  )
  (action_tile
    "rot"
    "(if (numberp (angtof $value))
            (setq rot (angtof $value))
            (progn
     (alert \"Nécessite une valeur d'angle valide\")
     (set_tile \"rot\" (angtos rot))
     (mode_tile \"rot\" 2)))"
  )
  (action_tile
    "inc"
    "(if (and (numberp (read $value))
            (<= 0 (read $value)))
            (setq inc (atoi $value))
            (progn
     (alert \"Nécessite un entier positif\")
     (set_tile \"inc\" (itoa inc))
     (mode_tile \"inc\" 2))))"
  )
  (action_tile
    "val"
    "(if (wcmatch $value \"~*.*\")
            (setq val $value)
            (progn
     (alert \"Nécessite uniquement des caractères alphabétiques et/ou numériques\")
     (set_tile \"val\" val)
     (mode_tile \"val\" 2))))"
  )
  (action_tile "pref" "(setq pref $value)")
  (action_tile "suff" "(setq suff $value)")
  (action_tile
    "accept"
    "(setq tag (atoi (get_tile\"tag\"))) (done_dialog)"
  )
  (action_tile "cancel" "(setq tag nil)")
  (start_dialog)
  (unload_dialog dcl_id)
  (vl-file-delete tmp)
  (if tag
    (while (setq ins (getpoint "\nSpécifiez le point d'insertion: "))
      (vla-put-Textstring
	(nth tag
	     (vlax-invoke
	       (vla-InsertBlock
		 space
		 (vlax-3d-point (trans ins 1 0))
		 name
		 scl
		 scl
		 scl
		 rot
	       )
	       'getAttributes
	     )
	)
	(strcat pref val suff)
      )
      (setq val (incsuff val inc 7))
    )
  )
)
(princ "\nCe bloc ne contient pas d'attributs.")
     )
   )
 )
 (princ)
)

 

autocad me dit : "; erreur: no function definition: GETBLOCK"

 

et comme je suis une bille en LISP si quelqu'un sais me dire ce que je dois modifier.

Ce lisp sert à incrémenter des blocks.

 

Merci d'avance !

[didier]

Coucou

 

ça veut dire que (gile) comme un bon professionnel a crée une sous-fonction ou un DCL et que certains des programmes y font appel

 

tu as trouvé les limites du copier-coller.

 

je pense que (gile) va te répondre.

 

amicalement

[(gile)]

Salut,

 

Le code que tu montres est un extrait du fichier Increment.lsp disponible ici ou là.

Ce fichier contient toutes les routines (getblock, mais aussi incsuff, incvalue) nécessaires au fonctionnement des commandes : inctxt (insertions multiples d'un texte) ; incatt (insertions multiples d'un bloc avec attribut) ; incsuf (incrémentation du suffixe des textes sélectionnés) ; incsel (incrémentation d'une valeur dans les textes sélectionnés) ; incadd (ajout d'une chaîne avec incrément) ; incr (choisir une de ces commandes).

 

Si, comme tu le dis : tu es "une bille en LISP", charge tout le contenu du fichier plutôt que d'essayer d'en extraire une ou des parties.

 

Par ailleurs, ce LISP date un peu, et depuis, j'ai publié sur Autodesk Exchange Apps un plug-in nommé Increment qui offre encore plus de possibilités.

[nG! Hebus]

"Désolé m'sieur, j'le f'rai pu" (DSK)

 

Ha ouep effectivement cela fonctionne mieux quand on à tout :)

 

Merci !

 

Donc je prend ma corde je vais me pendre et je vous remercie encore pour avoir pris le temps de me répondre.