avis de recherche lisp ou oua

[Big666]

bonjour

je recherche les lisps de patrick_35 ou et oua

le lien ne fonctionne plus .

merci

[DenisHen]

Pareil, je n'ai plus accès à ses téléchargement, le site est inaccessible pour l'instant...

 

Denis...

[usegomme]

Bonjour

Voici la version 2.11, qu'elle est la dernière ?

 

;;;=================================================================
;;;
;;; OU.LSP V2.11
;;;
;;; Localiser des blocs
;;;
;;; Copyright (C) Patrick_35
;;;
;;;=================================================================

(defun c:ou(/ bas cle doc ent fic lst nbl pos pt sel tbl tot totg xd xt
      dessine_ligne msgbox recherche_nom)

 ;;;---------------------------------------------------------------
 ;;;
 ;;; 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
 )

 ;;;---------------------------------------------------------------
 ;;;
 ;;; 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)
     (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)
   (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"
 )
 (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 "ou.dcl"))
     (progn
(setq fic (load_dialog fic) pos "0")
(vlax-map-collection (vla-get-blocks doc) 'recherche_nom)
(new_dialog "ou" fic "")
(start_list "bl")
(mapcar 'add_list (setq tbl (acad_strlsort tbl)))
(end_list)
(set_tile "titre" "OU V2.11")
(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 "OU" 16 "Le fichier OU.DCL est introuvable.")
   )
   (if sel
     (if (eq (cdr (assoc 0 (entget (car sel)))) "INSERT")
(progn
  (setq ent (vlax-ename->vla-object (car sel)))
  (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.")
     )
   )
 )
 (if nbl
   (if (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)
 (princ)
)

(setq nom_lisp "OU")
(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 la boite de dialogue

 

// =================================================================
//
//  OU.DCL V2.11
//
//  Copyright (C) Patrick_35
//
// =================================================================

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

[Big666]

MERCI

[lecrabe]

Hello

 

Pour la routne OU, j'ai la vs 2.12 ...

 

Bonnes Fetes, et surtout LA SANTE, Bye, lecrabe

 

[lecrabe]

Hello

 

Pour la routne OUA, j'ai la vs 1.01 ...

 

Bonnes Fetes, et surtout LA SANTE, Bye, lecrabe