somme des débits

[x_all]

Bonjour

ça faisait un moment que je cherchais un lisp pour calculer les débits des réseaux de ventil. Alors, pour faire suite à ce message, et qqs autres discutions portant sur les fonctions récursives, J'ai fini par m'en sortir pour pondre un petit programme.

 

Cette routine renseigne les attributs des blocs modélisant des bouches et des jonctions, Voir en entête du programme comment ça marche et ou charger les blocs. J'ai peu de test si l'utilisateur ne respecte pas les consignes ça pourrai planter... attention aux accrochage, les blocs doivent être sur des point de polyligne

Comme la routine est encore un peu toute neuve, je la poste pour test car je n'ai pas encore eu le temps de la stresser. Pour l'instant, je teste tout un calque et pas une sélection, . J' m'attendais à ce qu'il ne puisse y avoir qu'un seul arbre par calque, mais appartement ça marche avec plusieurs

Mais je n'ai pas encore trouvé comment cumuler des étages si ce n'est en renseignant à la main un attribut de la dernière jonction d'un arbre

 

Merci pour vos retours si vous trouvez des Bugs

 

Pour les puristes du lisp, ne cherchez pas, c'est codé avec les piedsIl y a encore pas mal de print de variable pour contrôle des ordres de calcul et des variables déclarées pour rien... bref, il y aura un version 5 un peu plus propre et moins disserte.

 

 

Merci à Patrick 35 et à (gile) pour leur lumières récursive...

;;                                                                                                      	;
;;   				Vsom V4  Somme des débits sur un calque de polyligne           						;
;;                                                                                                      	;
;; utile pour la ventil Les blocs 'bouche' et 'joncsion' sont disponible ici:                            	;
;; 					http://joch04.free.fr/soft/lisp/somme-debit-ventil-4.dwg                        	;
;;                                                                                                      	;
;; cumule les Q dans l'attribut T à l'avancement d'une branche                                          	;
;; cumule les branches dans le collecteur                                           						;

;; 			une branche commence toujours par une bouche (point 1 de la poly)                        	;
;;                    	elle se termine toujours par une jonction                 						;
;;                    	pas de jonction intermédiaire sans  sous branche                              	;

;; on peu rajouter des calculs sur les attributs à la fin des (cond de (traitebranche)                  	;
;; par exemple dans les blocs du dessin j'ai rajouté des attributs pour traiter les diamètres à l'avancement ;
;; dia est le diamètre théorique mini pour une vitesse   (Q=SV) 		V (m/s) Q (m3/h) DIA (m)        	;
;; la valeur de V (3 par défaut ) se change en dur au début du code                 						;
;;                                                                                                      	;



(defun c:vsom
 		(/   	ent 	i   	j   	n   	lay 	der
  		sspoly  poly	lsvtx   vtx 	pt  	ssblocs lsbloc
  		bloc	nombloc hbloc   lsbranche   	branche tcourant
  		ta  	Qt  	qc  	v   	doc 	test
 		)




				; initialisation VL
 (vl-load-com)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark doc)		; Activer le début de l'undo
 (setq	v 3.0
;; 3m/s pour un auditorium 5 pour des burreaux voir 6 pour les gros diamètres   
n
	0
test 0
 )

 (setq	ent (car (entsel "\nChoix d'une poly du réseau\n"))
lay (cdr (assoc 8 (entget ent)))
 )

				; liste de sélection des poly et blocs du calque


 (setq	sspoly (ssget "X" (list (cons 0 "LWPOLYLINE") (cons 8 lay)))
ssbloc (ssget "X" (list (cons 0 "INSERT") (cons 8 lay)))
 )

 ;; création de la liste des bloc lsbloc (pt hadle nombloc)   						
 (setq j 0)
 (repeat (sslength ssbloc)
(setq bloc (ssname ssbloc j)
)
(setq
 	j  		(+ 1 j)
 	hbloc   (cdr (assoc 5 (entget bloc)))
 	PT  	(cdr (assoc 10 (entget bloc)))
 	pt  	(reverse (cdr (reverse pt)))
 	Vba-ent (vlax-ename->vla-object bloc)
 	nombloc (vla-get-effectivename Vba-ent)

)
(setq lsbloc (cons (cons nombloc (list pt hbloc)) lsbloc)
)
 )					;fr

;;;  (print lsbloc)
;;;  (print (length lsbloc))


;;;   					traitement des poly  création de la liste des branches   			
;;;                	lsbranche de la forme	( ( nom tp handle1 ) (nom pt handle2) ...) 	
;;;                                                                                        	
 (setq i 0)
 (repeat (sslength sspoly)
(setq poly (ssname sspoly i)
)

(setq lsvtx	(mapcar	'cdr
		(vl-remove-if-not
 			'(lambda (x) (= (car x) 10))
 			(entget poly)
		)
	)
)
(princ "\n	")
;;;	(print lsvtx)

(foreach vtx lsvtx
 	(foreach bloc lsbloc
(setq pt (cadr bloc))
(if (equal vtx pt 0.02)
 	(setq branche (cons bloc branche))
 	;;                                                                                                                	;
 	;;  réinitialisation du Qt des blocs jonctions leur calcul servant de marqueur pour ordoner le parcour des branches   ;
 	;;                                                                                                                	;

 	(if (= "jonction" (car bloc))
	(progn
 		(setq hbloc (caddr bloc))
 		(Vb-Mod-att (handent hbloc) "Qt" 0)
	)
 	)
)
 	)					;fe bloc
)					;fe vtx
(setq branche (reverse branche))

;;                                                                         						;
;;            	controle du sens des polylignes                                              	;
;;                                                                         						;

(setq nombloc (car (car (reverse branche)))
 	pt  	(cadr (car (reverse branche)))
)
;;  Si le dernier bloc n'est pas une jonction Déssine un cercle, il faudra la retourner
(if	(/= nombloc "jonction")
 	(progn
(entmake (list (cons 0 "CIRCLE")
  			(cons 8 "---EPURES")
  			(cons 62 1)
  			(cons 10 pt)
  			(cons 40 0.5)
		)
)
(print "attention une poly à invserser")
(setq n (+ 1 n))
 	)
)					;fi



(setq lsbranche (cons branche lsbranche))
(setq i (+ 1 i)
 	branche nil
)


 )					;fr	Lsbranche prète

 ;;   					si  des branches a inverser, on sort.

 (if (/= n 0)
(progn
 	(alert "Attention il y a des polylignes à inverser")
 	(print n)
 	(exit)
)
 )


;;;;;;;;;                                                                   						;;;;;;;;
 ;;                                                                                              	;;;;;;;;
 ;;          	Explore fonction pour calculer les branches dans l'ordre                        	;;
 ;;          	toute les sous branches doivent avoir été cumulées pour     						;;;;
 ;;          	Qu'une branche soit traitable test sur le Qt=0   (Q transverssal remis à 0) 		;;
 ;;                                                                                              	;;;;;;;;
;;;;;;;;;                                                                   						;;;;;;;;

 (defun explore (arbre / brl bloc nombloc Nonvalide in)

(setq brl  (car arbre)
 	in   0
 	bloc nil
 	Qt   1
)
(setq Nonvalide 0)


(setq test (+ 1 test)
)
(if	(> test 100)
 	(progn
(print " +100 itérations.  jonction sans branche ?")
(exit)
 	)
)					;f
;;boucle pour test si un bloc "jonction" (sauf le dernier) de la branche à  Qt =0   	
(while (and (< in (length brl)) (/= 0 (length brl)))

 	(setq
bloc	(nth in brl)
hbloc	(caddr bloc)
nombloc	(car bloc)
 	) ;_ Fin de setq


 	;; test du Qt=0 d'un bloc qui n'est pas le dernier    	si oui Nonvalide = 1  	
 	(if (and (/= (+ 1 in) (length brl))
  		(= nombloc "jonction")
  		(= 0 (read (Vb-Val-att (handent hbloc) "Qt")))
 	)

(setq Nonvalide 1)
 	)

 	(setq in (+ 1 in))
) ;_ Fin de while

;;   Si Nonvalide modifié a 1, on ne peut pas calculer la branche 				
;;   on met donc ce bloc à la fin de celle ci et on rappelle explore    	
;;   avec cette nouvelle liste en espérant que le 1er élément soit traitable
(setq lg-arbre (length arbre))
(if	(= Nonvalide 1)
 	
 	;; permutation à (gile) le 1er devient le dernier
 	(progn
(princ "branche permutée  	")
(print brl)

(setq arbre
  		(append (cdr arbre)
  			(list (car arbre))
  		) ;_ Fin de append
) ;_ Fin de setq

(explore arbre)
;;;   		récurssivité

 	) ;_ Fin de progn




 	;;                                                               						;
 	;; Si non Nonvalide = 0 la branche est traitable                     						;
 	;; on traite, suprime cette branche de la collection et relance sur la nouvelle liste	;
 	;;                                                               						;
 	(progn
(TraiteBranche brl)

(print "branche traitée")
(print brl)

(if (setq arbre (cdr arbre))
 	(explore arbre)
;;;  	récurssivité
) ;_ Fin de if   			(and (/= 0 lg-arbre)

;;;	(print "fin de l'arbre")
;;;	(princ)
;;;;;;; 				par ici la sortie !!!!
 	)
) ;_ Fin de if
 ) ;_ Fin de defun


;;;fd explore                                                                                                    	
;;;fd explore                                                                                                    	
;;;fd explore                                                                                                    	





;;; (print (length lsbranche))
 (foreach branche lsbranche
(print branche)
 )




 (explore lsbranche)






 (print "sortie normale de Vsom")
;;; Fin de l'undo
 (vla-endundomark doc)
 (princ)
)
;;fin Vsom




;;                                                                                          	;;;;;;;;;;;;;;;;;;;
;;                                          	fonctions               						;;;;;;;;;;;;;;;;;;;
;;                                                                                          	;;;;;;;;;;;;;;;;;;;






;;                                                                       						;;;;;;;;;;;;;;;;;;;              	
;;                          	Traiement   d'une branche et maj Qt                          	;;;;;;;;;;;;;;;;;;; 				
;;                                                                       						;;;;;;;;;;;;;;;;;;;              	


(defun TraiteBranche (branche / i u bloc Qt qc dc dt tcourant ta)

 (setq	i	0
bloc nil
 )
 (while (< i (length branche))

(setq bloc  	(nth i branche)
 	nombloc (car bloc)
 	hbloc  	(caddr bloc)
)
;;test et mise a jour suivant le cas  
(cond

 	;;1er bloc
 	((= i 0)
  	(setq ta  		(read (Vb-Val-att (handent hbloc) "Q"))
		tcourant ta
  	)
  	(Vb-Mod-att (handent hbloc) "T" (rtos tcourant 2 0))
 	)

 	;;toutes jonctions sauf la dernière
 	;;         						
 	((and (= nombloc "jonction") (/= (+ 1 i) (length branche)))

  	(Vb-Mod-att (handent hbloc) "Qc" (rtos tcourant 2 0))
  	(setq tcourant (+ tcourant (read (Vb-Val-att (handent hbloc) "Qt")) ))
  	(Vb-Mod-att (handent hbloc) "T" (rtos tcourant 2 0))



  	;;diamètres
  	(setq dt (rtos (sqrt (/ (* 4 tcourant) (* pi v 3600))) 2 2))
  	;;nbr de décimales
  	(Vb-Mod-att (handent hbloc) "DIA-t" dt)

 	)




 	;;dernière jonction
 	((and (= nombloc "jonction") (= (+ i 1) (length branche)))

   	(Vb-Mod-att (handent hbloc) "Qt" (rtos tcourant 2 0))

  	;; cas d'arrivée sur une colonne l'attribut Qetage permet de renseigner une valleur à cumuler
  	;; utiliser les champs pour chainer les étages 
  	(if (setq Qc (read (Vb-Val-att (handent hbloc) "Qetage")))
	(progn
  	(Vb-Mod-att (handent hbloc) "Qc" (rtos Qc 2 0))
  	(setq tcourant (+ tcourant Qc))
	)
	(Vb-Mod-att (handent hbloc) "Qc" (rtos 0 2 0))
  	)				;i
  	
  	(Vb-Mod-att (handent hbloc) "T" (rtos tcourant 2 0))
 	

  	;;diamètres
  	(setq dt (rtos (sqrt (/ (* 4 tcourant) (* pi v 3600))) 2 2))
  	(Vb-Mod-att (handent hbloc) "DIA-t" dt)
  	(setq tcourant ta)

 	)


;;;débit
 	((= nombloc "bouche")
  	(setq Qc  		(read (Vb-Val-att (handent hbloc) "Q"))
		tcourant (+ tcourant Qc)
  	)
  	(Vb-Mod-att (handent hbloc) "T" (rtos tcourant 2 0))
				;diamètre
  	(setq dc (rtos (sqrt (/ (* 4 tcourant) (* pi v 3600))) 2 2))
  	;;nbr de décimales
  	(Vb-Mod-att (handent hbloc) "DIA" dc)

 	)
 	(t nil)
)					;fc

(setq i (+ 1 i))
 )					; fw


)					;fd


;;                                                                                                                  	
;;   						fin de traitement branche                                                              	
;;                                                                                                                  	


;; Vb-Val-att fonction Vlisp pour lire la valeur d'un attribut
				; ent correspond au handel du bloc (codedxf 5) à utiliser comme ça
;;   (setq toto (read (Vb-Val-att (handent handle) "REF")))

(defun Vb-Val-att (ent nomatt / att val)

 (foreach att
  		(vlax-invoke
		(vlax-ename->vla-object ent)
		'getattributes
  		) ;_ Fin de vlax-invoke
(and (eq (vla-get-tagstring att) nomatt)
				;comme ils disent les fou du code "tournure élégante !"
	(setq val (vla-get-textstring att))
				; le ET est équivalent à un si dans ce cas là 
)					;car on afffecte Val que si att= nom-att  bravo Patrick_35
 ) ;_ Fin de foreach
 val
 ;; retour de fonction
) ;_ Fin de defun
;;                                                                  	fin Vb-Val-att




;;  Vb-Mod-att fonction Vlisp pour modifier la valeur d'un attribut  ;; à utiliser comme ça
;;   				(Vb-Mod-att (handent handle) "NIV" new-val) 	(rtos 100)              	
;;  new-val est une string                                                                  	

(defun Vb-Mod-att (ent nom-att nval / att inc vblst-att)
 (setq	inc 0
vblst-att
	(vlax-invoke
  	(vlax-ename->vla-object ent)
  	'getattributes
	) ;_ Fin de vlax-invoke
 ) ;_ Fin de setq

 (while (< inc (length vblst-att))
(and (eq (vla-get-tagstring (nth inc vblst-att)) nom-att)
	(vla-put-textstring (nth inc vblst-att) nval)
)					;and
(setq inc (+ 1 inc))
 ) ;_ Fin de while
)					;
				; fin Vb-Mod-att 







;;;;                	Fdxf avec effective name  VBA                                   						
(defun Fdxf (entite / lstdxf)		; l'argument et la variable
 (setq lstdxf (entget entite))		; liste dxf normale
;;; definition du nom vba de l'entite
 (setq Vba-ent (vlax-ename->vla-object entite))
;;; récupération du effectivename et ajout à la lstdxf
 (setq bdn (vla-get-effectivename Vba-ent))
 (setq lstdxf (cons (cons "EffNameBlDyn" bdn) lstdxf))

 lstdxf				; le rappel de la variable sans rien sert
				;de valeur de retour de la fonction
)






;;  

[lecrabe]

Hello

 

Soit un bâtiment de bureaux d'environ 10 000 M2 par Étage. SVP cela représente environ combien de bouches et jonctions par étage ??

 

Bye, lecrabe

[x_all]

poulala, j'en sais rien, on fait pas de si gros chantier, le plus gros dossier que j'ai eu avait 150 ou 200 bouches pour 3 étages et puis ça dépend du type d'activité, des effectif de l'age de l’acousticien qui à tendance à diminuer les vitesses

 

 

(edit mis à jour le chemin vers le fichier qui n'était pas bon)