compter blocs en reseau

[Invité ingoenius]

Bonjour a vous, j'ai une routine pour compter les bloc qui marchais tré bien, mais avec le nouveua reseau dinamique de la 2013 elle ne compte pas le nombre de bloc repetes sur une trajectione ou sur un simple reseau rectangulaire ou polaire , il y a une astuce a ajouter dans le lisp??

 

(defun c:CB (/ 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] <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

      )
      
""
""	      
;originale	       "(Dynamique)"
;originale	       "(Statique)"

    )

  )

)

     )

     (textscr)

   )

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

 )

 (princ)

)