BCOUNT dépoussiéré

[(gile)]

Salut,

 

La commande BCOUNT des Express Tools datant un peu (pas de décompte des blocs dynamiques), j'ai écrit cette routine qui prend en compte ces blocs et permet une sélection par objet (cercle, ellipse ou polyligne fermée).

 

EDIT : Fonctionne aussi avec les version antérieures à 2006 (avant les blocs dynamiques)

 

;;; BCNT (gile)
;;; Comptabilise les blocs contenus dans une sélection
;;; Fonctionne comme BCOUNT des Express Tools plus :
;;; - le décompte des blocs dynamiques
;;; - la possibilité de sélectionner les objets contenus
;;;   dans un cercle, une ellipse ou une polyligne fermée.

(defun c:bcnt (/ kw ent typ ss dyn name lst ele len nb)
 (vl-load-com)
 (or *acdoc*
     (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
 )
 (or *blocks* (setq *blocks* (vla-get-Blocks *acdoc*)))
 (initget "Objet Tous Sélection")
 (setq	kw
 (getkword
   "\nSélectionnez les blocs ou [Objet/Tous/Sélection] [b]<[/b]Sélection>: "
 )
 )
 (cond
   ((= kw "Objet")
    (and
      (setq ent
      (car (entsel "\nSélectionnez le cercle, l'ellipse ou la polyligne: ")
      )
      )
      (setq typ (cdr (assoc 0 (entget ent))))
      (or (member typ '("CIRCLE" "ELLIPSE"))
   (and	(= typ "LWPOLYLINE")
	(= 1 (logand 1 (cdr (assoc 70 (entget ent)))))
   )
      )
      (setq ss (SelByObj ent "Wp" '((0 . "INSERT"))))
    )
   )
   ((= kw "Tous") (setq ss (ssget "_X" '((0 . "INSERT")))))
   (T (setq ss (ssget '((0 . "INSERT")))))
 )
 (if ss
   (progn
     (vlax-for	b (setq ss (vla-get-ActiveSelectionSet *acdoc*))
(setq name (if (vlax-property-available-p b 'EffectiveName)
	     (vla-get-EffectiveName B)
	     (vla-get-Name B)
	   )
)
(if (= (vla-get-IsXref (vla-Item *blocks* name)) :vlax-false)
  (if (setq ele (assoc name lst))
    (setq lst (subst (cons name (1+ (cdr ele))) ele lst))
    (setq lst (cons (cons name 1) lst))
  )
)
     )
     (vla-delete ss)
   )
 )
 (if lst
   (progn
     (princ "\nDécompte des blocs :\n")
     (setq len
     (+	7
	(apply 'max
	       (mapcar (function (lambda (x) (strlen (car x)))) lst)
	)
     )
     )
     (foreach p lst
(princ (strcat "\n\t" (car p)))
(repeat
  (- len (strlen (car p)) (strlen (setq nb (itoa (cdr p)))))
   (princ ".")
)
(princ nb)
(if (< 16.1 (read (substr (getvar "ACADVER") 1 4)))
  (princ
    (if
      (= (vla-get-IsDynamicBlock (vla-Item *blocks* (car p)))
	 :vlax-true
      )
       " (dynamique)"
       " (statique)"
    )
  )
)
     )
     (textscr)
   )
   (princ "\nAucun objet valide sélectionné.")
 )
 (princ)
)

;;; SelByObj -Gilles Chanteau- 06/10/06
;;; Crée un jeu de sélection avec tous les objets contenus ou  capturés,
;;; dans la vue courante, par un objet (cercle, ellipse, polyligne fermée)
;;; Arguments :
;;; - ent : un objet (ename ou vla-object) 
;;; - opt : un mode de sélection (Cp ou Wp)
;;; - fltr : un filtre de sélection (liste) ou nil
;;;
;;; modifié le 26/07/07 : fonctionne avec les objets hors fenêtre

(defun SelByObj	(ent opt fltr / obj dist n lst prec dist p_lst ss)
 (vl-load-com)
 (or *acad* (setq *acad* (vlax-get-acad-object)))
 (if (= (type ent) 'ENAME)
   (setq obj (vlax-ename->vla-object ent))
   (setq obj ent
  ent (vlax-vla-object->ename ent)
   )
 )
 (cond
   ((member (vla-get-ObjectName obj) '("AcDbCircle" "AcDbEllipse"))
    (setq dist	(/ (vlax-curve-getDistAtParam
	     obj
	     (vlax-curve-getEndParam obj)
	   )
	   50
	)
   n	0
    )
    (repeat 50
      (setq
 lst
  (cons
    (trans
      (vlax-curve-getPointAtDist obj (* dist (setq n (1+ n))))
      0
      1
    )
    lst
  )
      )
    )
   )
   ((and (= (vla-get-ObjectName obj) "AcDbPolyline")
  (= (vla-get-Closed obj) :vlax-true)
  )
    (setq p_lst (vl-remove-if-not
	   (function
	     (lambda (x)
	       (or (= (car x) 10)
		   (= (car x) 42)
	       )
	     )
	   )
	   (entget ent)
	 )
    )
    (while p_lst
      (setq
 lst
  (cons
    (trans (append (cdr (assoc 10 p_lst))
			 (list (cdr (assoc 38 (entget ent))))
		 )
		 ent
		 1
    )
    lst
  )
      )
      (if (/= 0 (cdadr p_lst))
 (progn
   (setq prec (1+ (fix (* 25 (sqrt (abs (cdadr p_lst))))))
	 dist (/ (- (if	(cdaddr p_lst)

		      (vlax-curve-getDistAtPoint
			obj
			(trans (cdaddr p_lst) ent 0)
		      )
		      (vlax-curve-getDistAtParam
			obj
			(vlax-curve-getEndParam obj)
		      )
		    )
		    (vlax-curve-getDistAtPoint
		      obj
		      (trans (cdar p_lst) ent 0)
		    )
		 )
		 prec
	      )
	 n    0
   )
   (repeat (1- prec)
     (setq
       lst (cons
	     (trans
		 (vlax-curve-getPointAtDist
		   obj
		   (+ (vlax-curve-getDistAtPoint
			obj
			(trans (cdar p_lst) ent 0)
		      )
		      (* dist (setq n (1+ n)))
		   )
		 )
		 0
		 1
	       )
	     lst
	   )
     )
   )
 )
      )
      (setq p_lst (cddr p_lst))
    )
   )
 )
 (cond
   (lst
    (vla-ZoomExtents *acad*)
    (setq ss (ssget (strcat "_" opt) lst fltr))
    (vla-ZoomPrevious *acad*)
    ss
   )
 )
) 

[Edité le 21/9/2008 par (gile)][Edité le 24/9/2008 par (gile)]

[Edité le 24/9/2008 par (gile)]

[lili2006]

Bonsoir à toutes et tous,

 

Comme d'hab au niveau efficacité,...

 

Merci pour le "dépoussiérage" de cette commande forte utile à ces heures,...,...

 

Nickel pour les BD,

 

Merci de ce partage, ;)

[lesourd2]

Salut (gile)

 

testé sans probleme

Merci .

[rebcao]

Bonne nuit à Toutes et à Tous,

 

Merci pour ce boulot,

 

Il me semble que notre cher Bipbip avait fait une telle demande

 

Christian

 

[Edité le 21/9/2008 par rebcao]

[lecrabe]

 

Hello

 

Du "grand" Gilles comme d'hab ! Merci beaucoup !! :)

 

Le Decapode "Ex BCOUNTer et maintenant FANA de BCNT)

 

PS: Je vais meme pouvoir compter mes blocs "SYMB_EQ3D" insérés dans les environs

de mes polylignes 3D par rapport à une zone géographique (Cercle ou Polygone) ;)

 

[lecrabe]

 

ReHello

 

Bravo en plus le BCNT de Gilles permet de récupérer le jeu de sélection précédent "P" :D

 

La routine BCOUNT des Express/Bonus nettoyait le jeu de sélection ! :o

 

Le Decapode

 

[autospeed]

super mais il serait intéressant de compter les blocs par calques en plus du résultat global etg prévoir une petite exportation sous excel

Phil http://www.kheops.biz

[(gile)]

super mais il serait intéressant de compter les blocs par calques en plus du résultat global etg prévoir une petite exportation sous excel

 

Bien sûr, on pourrait, et j'invite qui veut bien à modifier le code pour ce faire...

Mais à trop vouloir ajouter d'options à des commandes simples d'utilisation, on leur fait perdre une partie de leur intérêt.

De plus la commande EXTATTBE (qui fonctionne très bien) permet ce type d'exportation et bien plus.

[lecrabe]

 

Hello Gilles

 

Je confirme le bon fonctionnement de "BCNT.lsp" sur un bon vieux AutoCAD 2002 ! :)

 

Cependant je sollicite SVP une micro-modif :

Ajouter en fin de ligne derriere le nom et le total, la chaine suivante

" Bloc classique"

" Bloc dynamique"

 

J'espere que cela ne represente pas trop de boulot pour notre Lispeur / V-Lispeur

de compétition : le grand Gilles ! :D

 

Merci d'avance, Le Decapode

 

[(gile)]

Cependant je sollicite SVP une micro-modif :

Ajouter en fin de ligne derriere le nom et le total, la chaine suivante

" Bloc classique"

" Bloc dynamique"

 

C'est fait, le code est modifié.

[lecrabe]

 

Hello Gilles

 

Comme d'hab, c PARFAIT ! :)

 

Cependant je vais garder les 2 versions de la routine (BCNT & BCNT_11)

car la nouvelle version (que j'ai nommée 1.1) ne peut fonctionner que sur

des AutoCAD 2006 ou plus ! Ce qui est normal !!

 

Mais j'utilise souvent de vieux AutoCAD ou MAP (souvent 2004 parfois 2005)

pour des raisons de performance et vitesse de travail sur des gros DWGs ...

 

Nouvelle routine BCNT v1.1 testee et validee sur AutoCAD 2006 & ACAD 2009 :P

 

Le Decapode "heureux"

 

[lili2006]

Bonjour à toutes et tous,

 

Pareil pour moi !

 

Le lili2006 "pas malheureux" non plus, :P

[(gile)]

Re,

 

Pour les versions antérieures à 2006 (donc sans bloc dynamiques) BCOUNT devrait faire l'affaire, non ?

 

Je modifie le code pour qu'il teste la version courante et agisse en conséquence.

[lecrabe]

 

Hello Gilles

 

Admiration, admiration tu es un perfectionniste !

 

Encore Merci, Le Decapode

 

 

[rebcao]

AH ben moi j' aurais voulu qu'il me fasse aussi un Café !!! :casstet:

 

Ché pochible ? :exclam:

 

En tout cas merci pour ce nouvel outil fort pratique qui va certainent se retrouver dans les Express d'icic peu !!!

 

Christian

[ALEX-_-45]

Bonjour (gile),

Merci pour ce LISP et pour touts les autres que j’utilise pratiquement tous les jours.

Je cherche à modifier ton lisp pour qu’il me compte en regroupant des blocs exemple « CFO_PC » « CFO_PC_S » « CFO_PC_H » « CFO_PC_S_H » me compte tous les « CFO_PC*»

J’ai pas mal de bloc comme ça, que j’ai besoin de différencier sur les plans mais que je dois compter ensemble.

J’ai déjà pensé à utiliser le même bloc avec des êtas de visibilité pour les différentiés, mais ça pose deux problèmes.

C’est que je ne crée pas toujours les blocs avec leurs implantations il arrive qui soi déjà implanter, donc je change leur nom avec le nom de mes blocs et je copie tout le plan sur un dessin de référence pour les remplacé par les mien je ne vois pas comment continuer à utiliser cette méthode avec des êtas de visibilité.

Et deuxième point mon collègue n’aime pas le changement je viens à penne de lui faire arrêter de décomposer et copier en tant que bloc tout ce qui trouve.

Je ne comprends pas bien comment nb c’incrémente et où il va chercher ne nom des blocs,

Bon il faut dire également que j’ai vraiment du mal à apprendrez le LISP

Merci d’avance.