Comptage de blocs dans une polyligne

[anjary]

Bonjour ,je suis nouveau sur ce forum,que je trouve très intéressant et surtout très utile.je travail actuellement sur le projet de construction d'un hopital,ma partie étant les courants faibles.

je souhaite faire un quantitatif du matériels implantés dans différentes zone sur un étage.

je voudrais savoir s'il existe une commande pour compter le nombre de blocs dans une zone que j'aurais délimiter par une polyligne.

merci pour votre réponse.

 

 

 

[didier]

coucou

 

Bienvenue sur CadXp

 

dit comme ça, non, il n'existe pas de commande en natif

 

mais si tu veux on peux te faire un mini-programme qui le fera

 

à moins d'utiliser l'extrcation d'attributs (tes blocs ont-ils des attributs ?)

et de choisir les modes de sélection capture polygone ou fenêtre polygone.

 

gréviste

 

[rebcao]

Bonjour,

 

Voici un programme LISP qui permet de faire une sélection à partir de polyligne en mode FENETRE ou CAPTURE...

 

c'est un début

 

Christian

[lili2006]

Bonjour à toutes et tous,

 

Peut-être SELBLOC de _Zebulon ?

 

Super au passage,... ;)

 

Salut Christian,

 

Semble ne pas fonctionner chez moi ?? :o

[lecrabe]

Hello

 

Desole mais je pense que l'excellente routine BCNT de Gilles convient tout a fait !

 

La voici en version 1.3 en esperant que le BBCode ne la bousille pas !

 

Le Decapode

 

 

 

;;;

;;; La commande BCOUNT des Express Tools datant un peu (pas de decompte des blocs dynamiques),

;;; j'ai ecris cette routine qui prend en compte ces blocs

;;; et permet une selection par objet (cercle, ellipse ou polyligne fermee).

;;;

;;; EDIT : Fonctionne aussi avec les version anterieures a 2006 (avant les blocs dynamiques)

;;;

;;; ---------- BCNT par GC le 24/09/2008 - Version 1.2 ----------

;;; Comptabilise les blocs contenus dans une sélection

;;; Fonctionne comme BCOUNT des Express Tools avec en plus :

;;; - le decompte des blocs dynamiques

;;; - la possibilite de selectionner les objets contenus

;;; dans un cercle, une ellipse ou une polyligne fermee.

;;;

;;; ---------- Version 1.3 ----------

;;; (setq ss (SelByObj ent "Wp" '((0 . "INSERT"))))

;;; (setq ss (SelByObj ent "Cp" '((0 . "INSERT"))))

;;; Micro-Modif : question sur le type de Fenetre si option OBJET

;;;

 

 

(defun c:bcnt (/ kw ent typ ss dyn name lst ele len nb kw1 modeSel)

(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

"\nSelectionnez les Blocs ou [Objet/Tous/Selection] : "

)

)

(cond

((= kw "Objet")

 

;;; ---------- Micro-Modif par OD ----------

(initget "N C")

(setq kw1 (getkword "\nSelection de type Normale ou Capturante par l'objet selectionne /C : "))

(if (or (= kw1 nil) (= kw1 "N"))

(setq modeSel "Wp")

(setq modeSel "Cp")

)

;;; ---------- Fin Micro-Modif ----------

 

(and

(setq ent

(car (entsel "\nSelectionnez 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)))))

)

)

 

;;; ---------- Type de Fenetre : Wp (Normale) ou Cp (Capturante)

(setq ss (SelByObj ent modeSel '((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 "\nDecompte 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 (

(princ

(if

(= (vla-get-IsDynamicBlock (vla-Item *blocks* (car p)))

:vlax-true

)

" (dynamique)"

" (statique)"

)

)

)

)

(textscr)

)

(princ "\nAucun objet valide sélectionne.")

)

(princ)

)

 

;;; SelByObj - GC- 06/10/06

;;; Cree un jeu de selection avec tous les objets contenus ou captures,

;;; dans la vue courante, par un objet (cercle, ellipse, polyligne fermee)

;;; Arguments :

;;; - ent : un objet (ename ou vla-object)

;;; - opt : un mode de selection (Cp ou Wp)

;;; - fltr : un filtre de selection (liste) ou nil

;;;

;;; modifie le 26/07/07 : fonctionne avec les objets hors fenetre

 

(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

)

)

)

 

 

 

 

[lili2006]

Re,

 

Salut lecrabe,

 

Desole mais je pense que l'excellente routine BCNT de Gilles convient tout a fait !

 

Pourquoi désolé ? :o

 

Perso, j'aime bien aussi SELBLOC,... ;)

[zebulon_]

Perso, j'aime bien aussi SELBLOC,...

 

Moi aussi ;)

Euhh, je ne me souvenais même plus d'avoir fait cela.

 

Je ne suis plus très présent ces derniers temps et je m'en excuse auprès de vous. J'ai été un peu pris sur des chantiers importants (LGV Est Européenne et LGV Rhin Rhône). Par ailleurs, la maintenance de ce site laisse largement à désirer d'où également mon manque d'entrain à venir participer à ce qui devient malheureusement un grand n'importe quoi et on peut comprendre que certains puissent arborer un brassard de gréviste.

 

Amicalement

Vincent

 

[lili2006]

Re,

 

Euhh, je ne me souvenais même plus d'avoir fait cela.

 

Vu tout ce que tu as écrit,... ;)

 

Je ne suis plus très présent ces derniers temps

 

Oui, c'est dommage, on perd pas mal de forumer actif ces derniers temps je trouve,...

 

Je t'avoue que même moi, je conseil mon forum à mes étudiants même si celui-ci n'est pas encore très actif,...

 

En tous cas, merci à tous pour vos outils formidable, :P :D