Aller au contenu

Repères


BODJ

Messages recommandés

What???

 

Précision svp voir un petit screen parce que la... :mellow:

"98% des soucis informatiques sont assis entre la chaise et le bureau !"

 

"C'est parce que la vitesse de la lumière est supérieure à celle du son que tant de gens paraissent brillants avant d'avoir l'air con."
Lien vers le commentaire
Partager sur d’autres sites

Désolé pour le retour tardif..

 

Voici le résultat :

 

Commande: (entget (car (entsel)))

 

Choix de l'objet: ((-1 . <Nom d'entité: 7ffffb7e400>) (0 . "ACMBALLOON") (5 .

"11608") (102 . "{ACAD_REACTORS") (330 . <Nom d'entité: 7ffffb7e390>) (102 .

"}") (330 . <Nom d'entité: 7ffffb399f0>) (100 . "AcDbEntity") (67 . 0) (410 .

"Model") (8 . "HAB-3") (100 . "AcmSymbolClass") (102 . "leader") (90 . 31) (330

. <Nom d'entité: 0>) (91 . 257) (11 0.0 0.0 0.0) (140 . 30.0) (141 . -1.0) (102

. "begin of leader segments") (70 . 0) (90 . -1) (10 3110.3 2605.43

1.02783e-276) (102 . "begin") (70 . 0) (90 . -1) (10 3245.09 2979.08

1.02783e-276) (102 . "end") (102 . "end of leader segments") (102 . "end of

leader") (10 3245.09 2979.08 1.02783e-276) (11 1.0 0.0 0.0) (12 0.0 1.0 0.0)

(40 . 5.0) (1 . "ISO") (100 . "AcmBalloonClass") (90 . 0) (91 . 0) (70 . 1)

(330 . <Nom d'entité: 7ffffb7e390>))

Lien vers le commentaire
Partager sur d’autres sites

effectivement... ça se complique

 

confirmes tu que le n° du repère avec le quel tu as fait le test est HAB-8 ?

on devrai pouvoir bricoler un truc sur la base de OUA

 

je remet le code ici

[size=2][/size];;;=================================================================
;;;
;;; OUA.LSP V1.01
;;;
;;; Localiser des blocs
;;;
;;; Copyright (C) Patrick_35
;;;
;;;=================================================================

(defun c:oua(/ bas cle doc ent fic lst nbl pos pt s sel tbl tot totg val xd xt
  	*erroua* dessine_ligne inputbox msgbox recherche_nom)

 ;;;---------------------------------------------------------------
 ;;;
 ;;; Gestion des erreurs
 ;;;
 ;;;---------------------------------------------------------------

 (defun *erroua* (msg)
(or (member (strcase msg) '("FUNCTION CANCELLED" ""QUIT / EXIT ABORT"" "FONCTION ANNULEE" "QUITTER / SORTIR ABANDON"))
 	(princ (strcat "\nErreur : " msg))
)
(vla-endundomark doc)
(setq *error* s)
(princ)
 )

 ;;;---------------------------------------------------------------
 ;;;
 ;;; Message
 ;;;
 ;;;---------------------------------------------------------------

 (defun MsgBox (Titre Bouttons Message / Reponse WshShell)
(vl-load-com)  
(setq WshShell (vlax-create-object "WScript.Shell"))
(setq Reponse  (vlax-invoke WshShell 'Popup Message 0 Titre (itoa Bouttons)))
(vlax-release-object WshShell)
Reponse
 )

;-------------------------------------------------------------------------
; Saisir une valeur via une boite de dialogue
;-------------------------------------------------------------------------
 ;; InputBox (gile)
 ;; Ouvre une boite de dialogue pour récupérer une valeur
 ;; sous forme de chaine de caractère
 ;;
 ;; Arguments
 ;; tous les arguments sont de chaines de caractère (ou "")
 ;; box : titre de la boite de dialogue
 ;; msg : message d'invite
 ;; val : valeur par défaut
 ;;
 ;; Retour
 ;; une chaine ("" si annulation)

 (defun InputBox (box msg val / subr temp file dcl_id ret)
;; Retour chariot automatique à 50 caractères
(defun subr (str / pos)
 	(if (and
	(< 50 (strlen str))
	(setq pos (vl-string-position 32 (substr str 1 50) nil T))
  )
(strcat ":text_part{label=\""
	(substr str 1 pos)
	"\";}"
	(subr (substr str (+ 2 pos)))
)
(strcat ":text_part{label=\"" str "\";}")
 	)
)
;; Créer un fichier DCL temporaire
(setq temp (vl-filename-mktemp "Tmp.dcl")
  file (open temp "w")
  ret  ""
)
;; Ecrire le fichier
(write-line
 	(strcat
"InputBox:dialog{key=\"box\";initial_focus=\"val\";spacer;:paragraph{"
(subr msg)
"}spacer;:edit_box{key=\"val\";edit_width=54;allow_accept=true;}
spacer;ok_cancel;}"
 	)
 	file
)
(close file)
;; Ouvrir la boite de dialogue
(setq dcl_id (load_dialog temp))
(if (not (new_dialog "InputBox" dcl_id))	
 	(exit)
)
(set_tile "box" box)
(set_tile "val" val)
(action_tile
 	"accept"
 	"(setq ret (get_tile \"val\")) (done_dialog)"
)
(start_dialog)
(unload_dialog dcl_id)
;;Supprimer le fichier
(vl-file-delete temp)
ret
 )
 ;;;---------------------------------------------------------------
 ;;;
 ;;; Filtre les blocs anonymes et ceux associés aux xrefs
 ;;;
 ;;;---------------------------------------------------------------

 (defun recherche_nom(ent)
(or (wcmatch (vla-get-name ent) "`**,*|*")
(eq (vla-get-isxref ent) :vlax-true)
(not (eq (logand (cdr (assoc 70 (tblsearch "block" (vla-get-name ent)))) 2) 2))
 	(setq tbl (cons (vla-get-name ent) tbl))
)
 )

 ;;;---------------------------------------------------------------
 ;;;
 ;;; Dessine une ligne de 0,0 au point d'insertion du bloc
 ;;;
 ;;;---------------------------------------------------------------

 (defun dessine_ligne(ent / bl lay lst)
(setq lst (mapcar 'vla-get-textstring (vlax-invoke ent 'getattributes)))
(if (member val lst)
 	(progn
(setq lay (vla-item (vla-get-layers doc) (vla-get-layer ent)))
(if (vlax-property-available-p ent 'EffectiveName)
  (setq bl (vla-get-effectivename ent))
  (setq bl (vla-get-name ent))
)
(if (eq nbl bl)
  (setq totg (1+ totg))
)
(and (eq (vla-get-freeze lay) :vlax-false)
 	(eq (vla-get-layeron lay) :vlax-true)
 	(eq (vla-get-lock lay) :vlax-false)
 	(eq nbl bl)
 	(not (member (vlax-make-variant (vla-get-name lay)) lst))
 	(entmake (list (cons 0   "LINE")
			(cons 8   (vla-get-name lay))
			(cons 10  (trans pt 1 0))
			(cons 11  (vlax-get ent 'insertionpoint))
			(cons 410 (vla-get-name (vla-get-layout (vla-objectidtoobject (vla-get-database ent)(vla-get-ownerid ent)))))
	  	)
 	)
 	(setq tot (1+ tot))
)
 	)
)
(princ)
 )

 ;;;---------------------------------------------------------------
 ;;;
 ;;; Routine principale
 ;;;
 ;;;---------------------------------------------------------------

 (vl-load-com)
 (setq doc (vla-get-activedocument (vlax-get-acad-object))
cle "HKEY_CURRENT_USER\\Software\\Autodesk\\Autocad\\Patrick_35"
val ""
s *error*
*error* *erroua*
 )
 (if (vl-registry-read cle "Base_Ou_X")
(setq pt (list (atof (vl-registry-read cle "Base_Ou_X"))
	   (atof (vl-registry-read cle "Base_Ou_Y"))
	   (atof (vl-registry-read cle "Base_Ou_Z"))
 	)
)
(setq pt '(0.0 0.0 0.0))
 )
 (vla-startundomark doc)
 (while (not bas)
(initget "Choix Origine")
(setq sel (entsel "\nSélectionnez un Bloc / Choix / Origine : "))
(if (eq sel "Origine")
 	(progn
(if (setq bas (getpoint (strcat "\nVeuillez saisir le point d'origine (" (rtos (car pt) (getvar "lunits") 2) "," (rtos (cadr pt) (getvar "lunits") 2) "," (rtos (caddr pt) (getvar "lunits") 2) ") : ")))
  (progn
	(setq pt bas)
	(vl-registry-write cle "Base_Ou_X" (rtos (car pt)))
	(vl-registry-write cle "Base_Ou_Y" (rtos (cadr pt)))
	(vl-registry-write cle "Base_Ou_Z" (rtos (caddr pt)))
  )
)
(setq bas nil)
 	)
 	(setq bas T)
)
 )
 (if (eq sel "Choix")
(if (setq fic (findfile "oua.dcl"))
 	(progn
(setq fic (load_dialog fic) pos "0")
(vlax-map-collection (vla-get-blocks doc) 'recherche_nom)
(new_dialog "oua" fic "")
(start_list "bl")
(mapcar 'add_list (setq tbl (acad_strlsort tbl)))
(end_list)
(set_tile "titre" "OUA V1.01")
(set_tile "bl" pos)
(mode_tile "cancel" 2)
(action_tile "bl" 	"(setq pos $value)")
(action_tile "accept" "(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(if (eq (start_dialog) 1)
  (setq nbl (nth (atoi pos) tbl))
)
(unload_dialog fic)
 	)
 	(msgbox "OUA" 16 "Le fichier OU.DCL est introuvable.")
)
(if sel
 	(if (and (eq (cdr (assoc 0 (entget (car sel)))) "INSERT")
   	(eq (logand (cdr (assoc 70 (tblsearch "block" (cdr (assoc 2 (entget (car sel))))))) 2) 2)
  )
(progn
  (setq ent (vlax-ename->vla-object (car sel))
	val (vla-get-textstring (car (vlax-invoke ent 'getattributes)))
  )
  (if (not (vlax-property-available-p ent 'Path))
	(if (vlax-property-available-p ent 'EffectiveName)
  	(setq nbl (vla-get-effectivename ent))
  	(setq nbl (vla-get-name ent))
	)
  )
)
(princ "\nCe n'est pas un bloc avec attributs.")
 	)
)
 )
 (if (and nbl
   (not (eq (setq val (inputbox "OUA V1.01" "Indiquez la valeur de l'attribut" val)) ""))
   (ssget "x" (list (cons 0 "INSERT") (cons 2 (strcat nbl ",`**"))))
 	)
(progn
 	(if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-get-activepviewport (list doc))))
(progn
  (vla-getxdata (vla-get-activepviewport doc) "" 'xt 'xd)
  (setq lst (vlax-safearray->list xd))
)
 	)
 	(setq totg 0 tot 0)
 	(vlax-map-collection (setq sel (vla-get-activeselectionset doc)) 'dessine_ligne)
 	(vla-delete sel)
 	(princ (strcat "\n" (itoa totg) " " nbl " trouvé(s) et " (itoa tot) " ligne(s) de dessinée(s)."))
)
 )
 (vla-endundomark doc)
 (setq *error* s)
 (princ)
)

(setq nom_lisp "OUA")
(if (/= app nil)
 (if (= (strcase (substr app (1+ (- (strlen app) (strlen nom_lisp))) (strlen nom_lisp))) nom_lisp)
(princ (strcat "..." nom_lisp " chargé."))
(princ (strcat "\n" nom_lisp ".LSP Chargé.....Tapez " nom_lisp " pour l'éxecuter.")))
 (princ (strcat "\n" nom_lisp ".LSP Chargé......Tapez " nom_lisp " pour l'éxecuter.")))
(setq nom_lisp nil)
(princ)

 

 

et le DCL

 

// =================================================================
//
//  OUA.DCL V1.01
//
//  Copyright (C) Patrick_35
//
// =================================================================

oua : dialog {
 key = "titre";
 fixed_width = true;
 alignment = centered;
 is_cancel = true;
 width = 40;
 : list_box {label= "Bloc(s) avec attribut(s)" ; key="bl"; height = 15; multiple_select = false;}
 spacer;
 ok_cancel;
}

 

Mais c'est du VB et je ne voie pas bien quelle méthode utiliser.

Lien vers le commentaire
Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité