Inserer en 3D

[(gile)]

Un LISP qui permet, quelque soit le SCU courant, d'insérer un bloc dans un plan spécifié par 3 points (comme SCU 3 points) : le point d'insertion, un point sur l'axe des X positif et un point dans la zone des Y positifs.

 

Il est possible, de spécifier les échelles sur X, Y et Z en faisant Entrée, espace ou clic droit au lieu de spécifier le point d'insertion.

 

Le choix du block se fait à l'aide une petite boite de dialogue.

PS : la routine GetBlock (déjà utilisée ici) a été améliorée : elle propose par défaut le dernier bloc inséré (variable INSNAME).

 

PPS : pour les lispeurs,

- GetBlock réclame désormais un argument : le titre de la boite de dialogue ou nil (defaut: "Choisir un bloc").

- Il semble que la viarible INSNAME n'enregistre pas le nom d'un block inséré par entmake ou vla-insert, il faut donc le faire dans la routine qui utilise ces fonctions.

 

EDIT : Prise en compte des suggestions de Bred. Taper ins3d pour la boite de dialogue, -ins3d pour la ligne de commande.

 

EDIT2 : Prise en compte des suggestions de Bred.

- Le dernier bloc inséré est donné par défaut à la ligne de commande (taper Entrée ou clic droit pour valider)

- les directions des axes X et Ydu SCU courant sont données par défaut (taper Entrée, Espace ou clic droit pour valider)

 

Le fichier DCL à enregistrer sous getblock.dcl dans un dossier du chemin de recherche des fichiers de support.

 

getblock:dialog{
 label="Choisir un bloc";
 initial_focus="bl";
 :boxed_column{
   :row{
     :column{
       spacer;
       :text{
         label="Nom :";
         alignment=left;
       }
     }
     :column{
       :button{
         label="Parcourir...";
         key="wbl";
         alignment=right;
         fixed_width=true;
       }
       spacer;
     }
   }
   :edit_box{
     key="tp";
     edit_width=25;
   }
   :popup_list{
     key="bl";
     edit_width=25;
   }
   spacer;
 }
 ok_cancel;
}

 

Le LISP :

 

;; INS3D -Gilles Chanteau- (gile) 12/04/07
;; Insère un bloc dans le plan spécifié par 3 points
;; INS3D pour choisir le bloc dans la boite de dialogue
;; -INS3D pour entrer le nom à la ligne de commande.

;; Fonction d'appel boite de dialogue
(defun c:ins3d (/ nam)
 (and
   (setq nam (getBlock nil))
   (ins3d nam)
 )
 (princ)
)

;; Fonction d'appel ligne de commande
(defun c:-ins3d	(/ nam)
 (setq
   nam	(getstring T
	   (strcat "\Entrez le nom du bloc à insérer ou 			   (getvar "INSNAME")
		   ">: "
	   )
)
 )
 (or
   (and
     (or (/= nam "") (setq nam (getvar "INSNAME")))
     (or (tblsearch "BLOCK" nam)
  (findfile nam)
  (findfile (setq nam (strcat nam ".dwg")))
     )
     (ins3d nam)
   )
   (alert (strcat "Le bloc \""
	   (vl-string-right-trim ".dwg" nam)
	   "\" est introuvable."
   )
   )
 )
 (princ)
)

;; Fonction pricipale
(defun ins3d (nam / AcDoc Space opt xsc ysc zsc xpt ypt blk nor)
 (vl-load-com)
 (setq	AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space (if (= 1 (getvar "CVPORT"))
	(vla-get-PaperSpace AcDoc)
	(vla-get-ModelSpace AcDoc)
      )
 )
 (if (not
(setq opt
       (getpoint
	 "\nSpécifiez le point d'insertion ou : "
       )
)
     )
   (progn
     (if
(not (setq
       xsc (getreal
	     "\nEntrez le facteur d'échelle en  X : "
	   )
     )
)
 (setq xsc 1.0)
     )
     (if (not (setq
	 ysc
	  (getreal
	    "\nEntrez le facteur d'échelle en Y : "
	  )
       )
  )
(setq ysc xsc)
     )
     (if (not (setq
	 zsc
	  (getreal
	    "\nEntrez le facteur d'échelle en Z : "
	  )
       )
  )
(setq zsc xsc)
     )
     (initget 1)
     (setq opt (getpoint "\nSpécifiez le point d'insertion: "))
   )
   (setq xsc 1
  ysc 1
  zsc 1
   )
 )
 (setq	xpt opt
ypt opt
 )
 (while (equal xpt opt 1e-9)
   (or
   (setq xpt
   (getpoint
     opt
     "\nSpécifiez un point dans la zone positive de l'axe X du Bloc ou : "
   )
   )
   (setq xpt (mapcar '+ opt '(1 0 0)))
   )
 )
 (while (or (equal ypt opt 1e-9) (equal ypt xpt 1e-9))
   (or
   (setq ypt
   (getpoint
     opt
     "\nSpécifiez un point dans la zone des Y positifs ou : "
   )
   )
   (setq ypt (mapcar '+ opt '(0 1 0)))
   )
 )
 (foreach p '(opt xpt ypt)
   (set p (trans (eval p) 1 0))
 )
 (if (setq blk
     (vla-InsertBlock
       Space
       (vlax-3d-Point '(0 0 0))
       nam
       xsc
       ysc
       zsc
       0.0
     )
     )
   (progn
     (vla-TransformBy
blk
(vlax-tmatrix
  (append
    (mapcar
      '(lambda (v o)
	 (append v (list o))
       )
      (mxm
	(trp
	  (reverse
	    (list
	      (setq nor (norm_3pts opt xpt ypt))
	      (norm_3pts '(0 0 0) nor (mapcar '- xpt opt))
	      (vec1 opt xpt)
	    )
	  )
	)
	(mapcar
	  '(lambda (v) (trans v (trans '(0 0 1) 1 0 T) 0 T))
	  '((1 0 0) (0 1 0) (0 0 1))
	)
      )
      opt
    )
    (list '(0 0 0 1))
  )
)
     )
     (setvar "INSNAME" (vl-filename-base nam))
   )
 )
)

;;; VEC1 Retourne le vecteur normé (1 unité) de p1 à p2

(defun vec1 (p1 p2)
 (if (not (equal p1 p2 1e-009))
   (mapcar '(lambda (x1 x2)
       (/ (- x2 x1) (distance p1 p2))
     )
    p1
    p2
   )
 )
)

;;; NORM_3PTS retourne le vecteur normal du plan défini par 3 points

(defun norm_3pts (org xdir ydir)
 ((lambda (n)
    (if (inters org xdir org ydir)
      (mapcar '(lambda (x) (/ x (distance '(0 0 0) n))) n)
    )
  )
   ((lambda (x y)
      (list (-	(* (cadr x) (caddr y))
	(* (caddr x) (cadr y))
     )
     (-	(* (caddr x) (car y))
	(* (car x) (caddr y))
     )
     (-	(* (car x) (cadr y))
	(* (cadr x) (car y))
     )
      )
    )
     (mapcar '- xdir org)
     (mapcar '- ydir org)
   )
 )
)

;; Transpose une matrice Doug Wilson

(defun trp (m)
 (apply 'mapcar (cons 'list m))
)

;; Multiplie deux matrices Vladimir Nesterovsky

(defun mxm (m q)
 (mapcar '(lambda (r)
     (mapcar '(lambda (l) (apply '+ (mapcar '* l r)))
	     (apply 'mapcar (cons 'list q))
     )
   )
  m
 )
)

;;; Getblock Retourne le nom du bloc entré ou choisi par l'utilisateur 
;;; dans une liste déroulante de la boite de dialogue ou depuis la boite
;;; de dialogue standard d'AutoCAD
;;; Argument : le titre (string) ou nil (défaut : "Choisir un bloc")

(defun getblock	(titre / bloc n lst what_next dcl_id nom)
 (while (setq bloc (tblnext "BLOCK" (not bloc)))
   (setq lst (cons (cdr (assoc 2 bloc)) lst)
   )
 )
 (setq	lst (acad_strlsort
      (vl-remove-if '(lambda (n) (= (substr n 1 1) "*")) lst)
    )
 )
 (setq dcl_id (load_dialog "Getblock.dcl"))
 (setq what_next 2)
 (while (>= what_next 2)
   (if	(not (new_dialog "getblock" dcl_id))
     (exit)
   )
   (start_list "bl")
   (mapcar 'add_list lst)
   (end_list)
   (if	titre
     (set_tile "box" titre)
   )
   (or
     (and
(setq n	(vl-position
	  (strcase (getvar "INSNAME"))
	  (mapcar 'strcase lst)
	)
)
(setq nom (nth n lst))
     )
     (setq nom	(car lst)
    n	0
     )
   )
   (set_tile "bl" (itoa n))
   (action_tile "bl" "(setq nom (nth (atoi $value) lst))")
   (action_tile "wbl" "(done_dialog 3)")
   (action_tile "tp" "(setq nom $value) (done_dialog 4)")
   (action_tile
     "accept"
     "(setq nom (nth (atoi (get_tile \"bl\")) lst)) (done_dialog 1)"
   )
   (setq what_next (start_dialog))
   (cond
     ((= what_next 3)
      (if (setq nom (getfiled "Sélectionner un fichier" "" "dwg" 0))
 (setq what_next 1)
 (setq what_next 2)
      )
     )
     ((= what_next 4)
      (cond
 ((not (read nom))
  (setq what_next 2)
 )
 ((tblsearch "BLOCK" nom)
  (setq what_next 1)
 )
 ((findfile (setq nom (strcat nom ".dwg")))
  (setq what_next 1)
 )
 (T
  (alert (strcat "Le fichier \"" nom "\" est introuvable."))
  (setq	nom nil
	what_next 2
  )
 )
      )
     )
     ((= what_next 0)
      (setq nom nil)
     )
   )
 )
 (unload_dialog dcl_id)
 nom
)

[Edité le 11/4/2007 par (gile)][Edité le 11/4/2007 par (gile)][Edité le 12/4/2007 par (gile)]

 

[Edité le 12/4/2007 par (gile)]

[Bred]

Salut (gile),

je voulais tester ton lisp, mais j'ai une erreur :

 

Commande: INS3D

Utilisation: (acad_strlsort )

; erreur: quitter / sortir abandon

[(gile)]

Je pensais bien que ça pourait t'intéresser ;)

 

Ton erreur, c'est sur 2008 ?

Si oui, est-ce que la fonction acad_strlsort existe toujours ?

[Bred]

non, je suis sous 2006 là...

[(gile)]

:casstet:

 

La fonction existe bien en 2006 ?!

 

Tu peux toujours la supprimer, c'est dans GetBlock, tu n'auras pas la liste des blocs dans l'ordre alphabétique, c'est tout.

 

Mais je trouve l'erreur très bizarre ...

[(gile)]

Tu peux aussi remplacer :

(setq	lst (acad_strlsort
      (vl-remove-if '(lambda (n) (= (substr n 1 1) "*")) lst)
    )
 ) 

 

par:

(setq	lst (vl-sort
      (vl-remove-if '(lambda (n) (= (substr n 1 1) "*")) lst)
      '	    )
 ) 

[Bred]

HOp là! désolé, je m'étais tromper de répertoire lors de la copie du dcl...

Je t'ai fait attraper une petite sueur là....

[Bred]

Super !!!!.... c'est un peu bizarre à apréhender au début (les habitudes...), mais on s'y fait !

 

j'ai juste quelque remarques / suggestions :

 

- Une commande uniquement au clavier (-ins3d) pourrait être une option interressante (je bosse tout le temps au clavier pour l'insertion des blocs...)

 

- Lors de l'insertion, les intituler dans la ligne de commande "me trouble" :

Spécifiez un point dans la zone positive de l'axe X:

Spécifiez un point dans la zone des Y positifs:

En fait, de mon avis je trouverais plus compréhensible d'écrire

"Spécifiez un point dans la zone positive de l'axe X du Bloc:"...

... ou un truc comme ça...

 

... et le plus facile (pour la fin...)

- Si l'on pouvait avoir le bloc au bout du curseur et le voir "tourner" .... le rêve...

 

... mais ce dernier point est trop facile pour toi .... :P

 

[Edité le 11/4/2007 par Bred]

[(gile)]

J'ai modifié le code en prenat en compte tes deux premières suggestions.

À ce propos, je te renvoies au lien donné plus haut où c'est toi qui m'a fait rajouter plein de trucs à la boite dialogue de getblock, et maintenant tu n'en veux plus. :casstet:

 

Pour la troisième suggestion, j'ai un peu cherché, mais je ne vois pas, grread retourne des points dans le SCU courant, ROTATE3D n'affiche pas le (ou les) objet(s) en dynamique...

[Bred]

Super! merci !

(Vu le nombre de routine que tu postes ces temps-ci, il serait fabuleux de proposer ça comme les "lisp de Patrick_35" !)

 

À ce propos, je te renvoies au lien donné plus haut où c'est toi qui m'a fait rajouter plein de trucs à la boite dialogue de getblock, et maintenant tu n'en veux plus

Et bien si, justement, en fait mes souhait précédent concernant la boite de dialogue se recoupe avec le fait que j'utilise à 80 % le clavier pour l'appel des blocs : lorsque je ne me rappel plus du nom du bloc, j'appelle la boite de dialogue qui me permet de trouver en cherchant un peu le nom du bloc !...

(En fait j'utilise le même principe avec" -i et i")

[Bred]

Salut (gile),

J'abuse, mais après encore quelque test, j'ai encore quelques suggestions....

 

- lors de l'insertion au clavier, il serait bien de proposer en valeur par défaut du nom du bloc à insérer le blocs précédement insérer ...

 

- lors de la demande d'orientation du bloc, il serait bien que si l'on valide sans rentrer un point, il prenne par défault la parrallèlle au scu actif...

par exemple, si j'ai comme vue à l'écran un vue parrallèle au sens X, Z et que je veux insérer un bloc en "forçant" l'orientation des x uniquement, je ne peux pas le faire car le lisp m'oblige à donner un point sur les Y (ce que je ne peux pas faire vue que ma vue est sur la normale...)

Actuellement je ne peux pas faire comme l'image ci-dessous, car je ne peux pointer un point sur les Y...

http://xs414.xs.to/xs414/07154/INS3D1.JPG

merci...

[(gile)]

Le code est modifié selon tes demandes.

[Bred]

C'est superbe !!!!

merci !

:) :) :)