Insérer bloc en 3d

[usegomme]

Salut tout le monde .

Il s'agit d'un bout de lisp "bidouille" , secondé par getblock de (gile) [Merci (gile)].

L' intêret c' est d'insérer un bloc au point voulu , de VOIR l' orientation du bloc en question, puis en redéfinissant les axes x et y du scu d' obtenir l' orientation souhaitée en 3d.

 

13.lsp , le i de insérer est devenu 1 et 3 pour 3d

;; insère bloc en 3 d
;; insère bloc  puis demande redéfinition des axes x et y (scu) et reinsere le bloc en fonction du nouveau scu
;;usegomme le 18-01-2010
;; fonctionne avec Getblock de (gile)
(defun c:13 (/ nam)
   (setq nam (getBlock nil))   
   (command "_insert" nam "_s" 1 "_r" 0)
   (while (not (zerop (getvar "cmdactive")))(command pause))
   (command "_ucs"  "_non" (getvar "lastpoint"))
   (while (not (zerop (getvar "cmdactive")))(command pause))
   (entdel (entlast))   ;; efface bloc
   (command "_insert" nam  "_s" 1 "_r" 0 "_non" (getvar "lastpoint"))  
   (while (not (zerop (getvar "cmdactive")))(command pause))
   (command "_ucs" "_p")
 (princ)
)


;;; Getblock (gile) 03/11/07
;;; 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 tmp file 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
	 (function (lambda (n) (= (substr n 1 1) "*")))
	 lst
       )
     )
tmp  (vl-filename-mktemp "Tmp.dcl")
file (open tmp "w")
 )
 (write-line
   (strcat
     "getblock:dialog{label="
     (cond (titre (vl-prin1-to-string titre))
    ("\"Choisir un bloc\"")
     )
     ";initial_focus=\"bl\";:boxed_column{
     :row{:text{label=\"Sélectionner\";alignment=left;}
     :button{label=\">>\";key=\"sel\";alignment=right;fixed_width=true;}}
     spacer;
     :column{:button{label=\"Parcourir...\";key=\"wbl\";alignment=right;fixed_width=true;}}
     :column{:text{label=\"Nom :\";alignment=left;}}
     :edit_box{key=\"tp\";edit_width=25;}
     :popup_list{key=\"bl\";edit_width=25;}spacer;}
     spacer;
     ok_cancel;}"
   )
   file
 )
 (close file)
 (setq dcl_id (load_dialog tmp))
 (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	(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 "sel" "(done_dialog 5)")
   (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 5)
      (if (and	(setq ent (car (entsel)))
	(= "INSERT" (cdr (assoc 0 (entget ent))))
   )
 (setq nom	 (cdr (assoc 2 (entget ent)))
       what_next 1
 )
 (setq what_next 2)
      )
     )
     ((= what_next 0)
      (setq nom nil)
     )
   )
 )
 (unload_dialog dcl_id)
 (vl-file-delete tmp)
 nom
)

(prompt "\n Commande  13  chargée") (princ)

[(gile)]

Salut,

 

J'avais fait un truc : Ins3d sur cette page

[usegomme]

Salut , je sais , ton INS3D c'est du super costaud , mais j'en suis venu à mon bricolage à cause de bibliothèques de blocs anarchiques dont j'avais besoin d'un aperçu pour savoir comment les orienter sans me tromper.