Créer bloc en vl.. d\'après selection

[Bred]

Salut,

Je n'arrive pas en m'en sortir dans la logique vla-... pour créer un bloc d'après une sélection.... (le type d'objet de la selection peut être n'importe quoi : cercle, polyligne, blocs, ...) :mad:

 

en autolisp je fait

(setq ss (ssget))
(command "_-block" "Mon_Bloc" "_none" '(0 0 0) ss "")
(command "_-INSERT" "Mon_Bloc" "_none" '(0 0 0) "1" "1" 0)

 

... mais en vla, je n'y arrive vraiment pas !!!

 

merci d'avance !

[ElpanovEvgeniy]

Salut,

Je n'arrive pas en m'en sortir dans la logique vla-... pour créer un bloc d'après une sélection.... (le type d'objet de la selection peut être n'importe quoi : cercle, polyligne, blocs, ...) :mad:

 

en autolisp je fait

(setq ss (ssget))
(command "_-block" "Mon_Bloc" "_none" '(0 0 0) ss "")
(command "_-INSERT" "Mon_Bloc" "_none" '(0 0 0) "1" "1" 0)

 

... mais en vla, je n'y arrive vraiment pas !!!

 

merci d'avance !

 

Salut! :)

 

(command "_-block" "Mon_Bloc" "_none" '(0 0 0) ss "") 

(if (setq ss (ssget))
(progn
 (setq doc  (vla-get-activedocument (vlax-get-acad-object))
       lst  (mapcar (function vlax-ename->vla-object)
                    (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex ss)))
            ) ;_  mapcar
       blk  (vla-add (vla-get-blocks doc) (vlax-3d-point 0. 0. 0.) "test-block")
       barr (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray '9 (cons 0 (1- (length lst)))) lst))
 ) ;_ setq
 (vla-copyobjects doc barr blk)
) ;_  progn
) ;_  if 

 

(command "_-INSERT" "Mon_Bloc" "_none" '(0 0 0) "1" "1" 0) 

 

(vla-insertblock (vla-get-ModelSpace doc) (vlax-3d-point 0. 0. 0.) "test-block" 1. 1. 1. 0.) 

 

 

 

[Bred]

ah ben oui... je comprends maintenant pourquoi je n'y arrivait pas..... : il faut être intelligent !!! :P

merci ElpanovEvgeniy !!! ;)

 

(je rajoute juste un

(foreach n lst (vla-delete n))

pur effacer la sélection.

[Bred]

Après test, Il y a une erreur d'orientation avec un SCU non parrallèle au SCG.

D'après ce message, (gile) m'avait proposé cette méthode qui fonctionne....

(vla-insertblock
(vla-get-ModelSpace
(vla-get-activedocument (vlax-get-acad-object))
)
[b](vlax-3d-point (trans '(0 0 0) 1 0))[/b]
"NomB"
1
1
1
[b](angle '(0 0 0)
(trans (getvar "UCSXDIR") 0 (trans '(0 0 1) 1 0 T))[/b]
)
)

mais pas de ce cas là !!! :casstet:

 

----------------------------------------------------------------

j'édite

En fait je viens de me rendre compte que (et c'est logique), le souci ne viens pas de l'insertion "final" du bloc, mais de sa construction dans

(vla-copyobjects (vla-get-activedocument (vlax-get-acad-object)) barr blk)

... il faudrait donc faire faire une rotation aux éléments constituant le bloc de la valeur de la rotation du SCU... j'ai tester à l'instinct (sans aucune reflexion approfondis j'avoue ) un

(foreach n lst (vla-rotate n (vlax-3d-point (trans p 1 0))(angle '(0 0 0) (trans (getvar "UCSXDIR") 0 (trans '(0 0 1) 1 0 T)))))

avant la construction du bloc, mais ça ne fonctionne (bien sûr) pas....

merci de votre aide !

 

[Edité le 25/2/2007 par Bred]

[Bred]

:casstet: Je cherche et je ne trouve pas.... personne pour m'aider ?

[(gile)]

Salut,

 

Juste une idée comme ça, je ne peux pas tester.

 

Pour chaque entité du jeu de sélection

 

(vla-transformby n (UCS2WCSMatrix))

 

puis le vla-CopyObjects.

[Bred]

Salut,

merci (gile), cela à l'air de fonctionner, en y incluant la transformation de point d'insert et de la rotation dans vla-insertblock.

 

(defun c:bt ()
 
(setq ss (ssget)
p (getpoint))
 
(setq NBT (strcat "BLOC - " (itoa (fix (* (getvar "TDUSRTIMER") 10000000))))
      lst (mapcar (function vlax-ename->vla-object)
	   (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex ss))))
      blk (vla-add (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
	    (vlax-3d-point p) NBT)
      barr (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray '9 (cons 0 (1- (length lst)))) lst)))

 (foreach n lst (vla-transformby n (UCS2WCSMatrix)))
 
 (vla-copyobjects (vla-get-activedocument (vlax-get-acad-object)) barr blk)
 
 (foreach n lst (vla-delete n))
 
 (vla-insertblock (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
   (vlax-3d-point (trans p 1 0)) NBT 1 1 1
   (angle '(0 0 0) (trans (getvar "UCSXDIR") 0 (trans '(0 0 1) 1 0 T))))
   
)

 

avec

;; Doug C. Broad, Jr.
;; can be used with vla-transformby to
;; UCS2WCSMatrix transform objects from the UCS to the WCS
(defun UCS2WCSMatrix ()
 (vlax-tmatrix (append (mapcar '(lambda (vector origin) (append (trans vector 1 0 T) (list origin)))
			(list '(1 0 0) '(0 1 0) '(0 0 1))
			(trans '(0 0 0) 0 1))(list '(0 0 0 1))))
)

(et encore un grand merci à ElpanovEvgeniy !)

------------------------------------------------------

petit détail : j'ai un " # < VLA-OBJECT IAcadBlockReference2 xxxxxxxx > " qui s'affiche sur la ligne de commande.... il y a un moyen de l'éviter ?

 

 

 

[Edité le 28/2/2007 par Bred]

[ElpanovEvgeniy]

petit détail : j'ai un " # < VLA-OBJECT IAcadBlockReference2 xxxxxxxx > " qui s'affiche sur la ligne de commande.... il y a un moyen de l'éviter ?

Salut!

Ajoute а la fin du programme

(princ) 

[Bred]

Спасибо!

 

(merci !... c'est ça ?.... - http://translate.google.com)

[(gile)]

Salut,

 

Je suis content que l'utilisation de matrice fonctionne, mon intuition était bonne.

 

Deux petites remarques pour améliorer ton code :

 

1 - Comme me le disait BTO ici, pour une exécution plus rapide dans le traitement des jeux de sélection, il vaut mieux utiliser un (repeat ...) qu'un enchainement du type (mapcar ... (vl-remove-if ... (mapcar ...))) qui fait parcourir le jeu de sélection trois fois au lieu d'une.

 

(repeat (setq n (sslength ss))
   (setq
     lst (cons	(vlax-ename->vla-object (ssname ss (setq n (1- n))))
	lst
  )
   )
 ) 

 

2 - L'utilisation de (vlax-Invoke ...) permet d'éviter de transformer une liste en variant pour la passer comme argument à une fonction vla-*.

 

(vlax-Invoke
   (vla-get-activedocument (vlax-get-acad-object))
   'CopyObjects
   lst
   blk
 ) 

[Bred]

C'est noté, merci (gile).

 

(defun c:bt2 (/ BLK LST N NBT P SS)
 
(setq ss (ssget)
p (getpoint))
 
(setq NBT (strcat "BLOC - " (itoa (fix (* (getvar "TDUSRTIMER") 10000000)))))
 
 (repeat (setq n (sslength ss))
   (setq lst (cons (vlax-ename->vla-object (ssname ss (setq n (1- n)))) lst)))
 
 (setq blk (vla-add (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
	     (vlax-3d-point p) NBT))
 
 (foreach n lst (vla-transformby n (UCS2WCSMatrix)))  
 (vlax-Invoke (vla-get-activedocument (vlax-get-acad-object)) 'CopyObjects lst blk)  
 (foreach n lst (vla-delete n))  
 (vla-insertblock (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
   (vlax-3d-point (trans p 1 0)) NBT 1 1 1
   (angle '(0 0 0) (trans (getvar "UCSXDIR") 0 (trans '(0 0 1) 1 0 T))))
 (princ)
)

 

[Edité le 28/2/2007 par Bred]