Calque bloc INCATT

[lulu3109]

Bonjour

 

Savez vous comment peut ont modifier le code du lisp INCATT afin que le bloc soit inséré dans un calque particulier?

 

Lulu

[DenisHen]

Salut.

 

Peut-être que son auteur se manifestera, mais apparemment, le bloc est insérer dans le calque courant.

 

Pourquoi modifier ce Lisp ?

 

Il suffit de créer le calque avant le lancement de la routine...

[(gile)]

Salut,

 

Tu peux utiliser cette version en remplaçant "0" par le nom du calque que tu veux (vers la fin de la routine).

L'inconvénient c'est que quel que soit le bloc inséré, il le sera toujours sur ce calque, c'est pourquoi j'avais préféré laisser le calque courant qu'on ne manque pas d'établir avant d'utiliser ce genre de commande.

 

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

 (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
    (progn
      (while (setq
	       ins (getpoint "\nSpécifiez le point d'insertion: ")
	     )
	(vla-put-Textstring
	  (nth tag
	       (vlax-invoke
		 (setq blk
			(vla-InsertBlock
			  space
			  (vlax-3d-point (trans ins 1 0))
			  name
			  scl
			  scl
			  scl
			  rot
			)
		 )
		 'getAttributes
	       )
	  )
	  (strcat pref val suff)
	)
	(vla-put-Layer blk "0")	; <- remplacer par le nom du calque
	(setq val (incsuff val inc 7))
      )
    )
  )
)
(princ "\nCe bloc ne contient pas d'attributs.")
     )
   )
 )
 (princ)
)

[lulu3109]

super sa me débloque!

Mes collègues ne prenait jamais le temps de renseigner le bon calque avec cette fonction particulière.

Le seul bémol c'est que l'insertion ne crée pas le calque. Il faut le prévoir dans le gabarit (twist des fichiers anciens) mais c'est déjà beaucoup.

merci GILE

[DenisHen]

Pour créer le calque s'il n'existe pas, remplace la ligne indiquée par (gile) par ce code :

(if (not (tblsearch "layer" "NomDuCalque"))
 (command "-calque" "n" "NomDuCalque" "")
)

 

Et tape le bon NomDuCalque aux deux endroits...

[lulu3109]

Merci pour ce bout de code DenisHen.

Fallait pas remplacer mai rajouter juste avant la ligne indiqué par (gile).

Encore merci