(setq VAR_ACAD_DEF_BLOC "AcDbBlockReference")

;------------------------------------;
; nom: profondeur_du_bloc_dbx        ;
; role: renvoie la profondeur du bloc;
;       bloc_name contenu dans le    ;
;       fichier pointé par dbx       ;
; param: dbx => pointeur vla sur un  ;
;               fichier autocad      ;
;        bloc_name => string, nom de ;
;                     bloc           ;
; retour: un couple =>               ;
;         (bloc_name . profondeur)   ;
;         nil si erreur              ;
; date: 30/11/2009                   ;
; Sébastien BLAES                    ;
;------------------------------------;
(defun profondeur_du_bloc_dbx( dbx bloc_name / res dbx_blocs data vla_def_bloc_name profondeur vla_contenu vla_sous_bloc_name)
  	(setq res nil)
  	(vl-load-com)
  
  	(cond
		; on vérifie s'il y a des blocs
		((= (vl-catch-all-error-p (setq dbx_blocs (vl-catch-all-apply 'vla-get-Blocks (list dbx)))) t)
		 	; erreur
		)

		; on teste si on ne connait pas déjà la profondeur du bloc bloc_name
		((/= (setq data (assoc bloc_name VAR_BLOC_PROFONDEUR)) nil)
		 	(setq res (cdr data))
		)
		
		; on récupère la définition du bloc
		((= (vl-catch-all-error-p (setq vla_def_bloc_name (vl-catch-all-apply 'vla-item (list dbx_blocs bloc_name)))) t)
		 	; erreur
		)

		(t
		 	(setq profondeur 1)
		 
		 	; on parcourt la définition du bloc
		 	(vlax-for vla_contenu vla_def_bloc_name
			  	(cond
				  	; on teste si l'entité est un bloc ou non
				  	((/= (vla-get-ObjectName vla_contenu) VAR_ACAD_DEF_BLOC)
					 	; ce n'est pas un bloc, donc profondeur = 1
					 						 	
					)

					; on récupère le nom de ce sous-bloc
					((or (and (= (vla-get-IsDynamicBlock vla_contenu) :vlax-true)
						  (= (setq vla_sous_bloc_name (vla-get-EffectiveName vla_contenu)) nil))
					     (and (= (vla-get-IsDynamicBlock vla_contenu) :vlax-false)
						  (= (setq vla_sous_bloc_name (vla-get-Name vla_contenu)) nil)))
					)
					
					; comme vla_contenu est un bloc, il faut calculer sa profondeur
					; on vérifie d'abord si on ne la connait pas déjà
					((/= (setq data (assoc vla_sous_bloc_name VAR_BLOC_PROFONDEUR)) nil)
					 	; on prend le maximum entre la profondeur maximale
					 	; déjà trouvée et celle +1 de ce sous-bloc
					 	(setq profondeur (max profondeur (1+ (cdr data))))
					)

					; on ne connait pas encore la profondeur de ce bloc
					; donc on va la calculer
					((= (setq data (profondeur_du_bloc_dbx dbx vla_sous_bloc_name)) nil)
					)

					(t
					 	; on prend le maximum entre la profondeur maximale
					 	; déjà trouvée et celle +1 de ce sous-bloc
					 	(setq profondeur (max profondeur (1+ (cdr data))))
					)					
				) ; cond
			) ; vlax-for

			(setq res (cons bloc_name profondeur)
			      VAR_BLOC_PROFONDEUR (cons res VAR_BLOC_PROFONDEUR))
		)
	) ; cond
	
	res
) ; profondeur_du_bloc_dbx

;-----------------------------------;
; nom: profondeur_maxi_des_blocs    ;
; role: renvoie le nom du bloc et sa;
;       profondeur pour celui ayant ;
;       la profondeur la plus élevée;
; param: aucun                      ;
; retour: un couple =>              ;
;         (bloc_name . profondeur)  ;
;         nil si erreur             ;
; date: 01/12/2009                  ;
; Sébastien BLAES                   ;
;-----------------------------------;
(defun profondeur_maxi_des_blocs( / res dbx vla_bloc_def vla_bloc_name profondeur_maxi bloc_profondeur_maxi)
  	(setq res nil)
  	(vl-load-com)

  	(cond
	  	; on ouvre le fichier de test
  		;((= (setq dbx (ouvrir_dessin_dbx_no "C:/sauvegarde_SBS/save cle usb/seb/LISP/Challenge30.dwg")) nil)
		;)
		((= (setq dbx (vla-get-ActiveDocument (vlax-get-acad-object))) nil)
		)

		(t
		 	; variable globale contenant des couples : (nom_du_bloc . profondeur_du_bloc)
		 	(setq VAR_BLOC_PROFONDEUR '())
		 
		 	; on va calculer la profondeur de chaque bloc
		 	(vlax-for vla_bloc_def (vla-get-Blocks dbx)
			  	(setq vla_bloc_name nil)

			  	(and (= (vla-get-IsDynamicBlock vla_bloc_def) :vlax-true)
				     (= (vlax-property-available-p vla_bloc_def 'EffectiveName) t)
				     (setq vla_bloc_name (vla-get-EffectiveName vla_bloc_def))
				) ; and
				  	

			  	(and (= (vla-get-IsDynamicBlock vla_bloc_def) :vlax-false)
				     (setq vla_bloc_name (vla-get-Name vla_bloc_def))
				) ; and
			  	
				(if (/= vla_bloc_name nil)
				  	(profondeur_du_bloc_dbx dbx vla_bloc_name)
				) ; if
			) ; vlax-for

		 	; on referme le dessin
		 	;(fermer_dessin_dbx dbx)

			; on cherche maintenant le bloc ayant la profondeur maxi
		 	(setq profondeur_maxi 0
			      bloc_profondeur_maxi "")

		 	(mapcar '(lambda (elem)
				   	(cond
					  	((or (= (wcmatch (strcase (car elem)) "*MODEL_SPACE") t)
						     (= (wcmatch (strcase (car elem)) "*PAPER_SPACE*") t))
						 	; on ignore les présentations et espace objet
						)

						((> (cdr elem) profondeur_maxi)
						 	(setq profondeur_maxi (cdr elem)
							      bloc_profondeur_maxi (car elem))
						)
					) ; cond
				)
				VAR_BLOC_PROFONDEUR
			) ; mapcar

		 	(and (/= bloc_profondeur_maxi "")
			     (> profondeur_maxi 0)
			     (setq res (cons bloc_profondeur_maxi profondeur_maxi))
			) ; and
		) ; t
	) ; cond

  	res
) ; profondeur_maxi_des_blocs