somme des débits

Olivier Eckmann · le 26 mai 2018

Bonjour,

Pour les jonctions, je comprends que ce soit perturbant que ça fonctionne tout seul, mais oui ça marche.

Je joins un schéma qui sera plus compréhensible qu'un long discours. ICI

L'appellation TC correspond au total en cours à chaque sommet pour la polyligne en cours de traitement.

Olivier

x_all · le 26 mai 2018

j'ai bien compris, mais à moins d'automatiser le calcul de réseau complet (et de réinitialiser les T a chaque mise a jour) , ça va être fastidieux de devoir tout reprendre en cas de modif sur une branche (et des modifs yana 10 par jour en conception).

Un réseau courant, c'est vite deux ou 3 branches par étage, encore un problème plus facile a régler avec un bloc de jonction qui renvoie à un autre graphe.

C'est un peu tard, mais je tente un truc.

Olivier Eckmann · le 26 mai 2018

Bonsoir,

Si ça doit être dynamique on peut envisager de faire faire les sommes à AutoCAD à l'aide des champs.

Video expliquant la possibilité : ICI

Ensuite on pourrait envisager un Lisp qui automatise la construction des relations

Olivier

Olivier Eckmann · le 26 mai 2018

Bonsoir,

autre possibilité, on peut "reconstruire" l'arborescence du réseau avec une propriété sur chaque polyligne.

J'ai utilisé l'épaisseur car en 2D ça ne sert à rien et en 3D ça peut servir de contrôle sur la structure de ton réseau avec la visu 3D de l'épaisseur progressive au fur et à mesure que tu "descend" ton réseau..

Le principe est d'affecter une épaisseur correspondant au niveau de ta branche : 1 pour le niveau amont et 2, 3... pour les niveaux d'imbrication suivant en descendant vers l'aval.

ICI la vidéo expliquant la mise en œuvre

Comme je l'ai simulé sur la vidéo, l'ajout d'une nouvelle branche sur une branche déjà existante est possible à condition de couper la poly à la nouvelle jonction et d'affecter une épaisseur intermédiaire avec la branche suivante.

Partant du code proposé précédemment, je l'ai modifié pour sélectionner en une fois les polylignes et les blocs à traiter après avoir remis l'attribut T à 0 sur tous les blocs.

(defun C:SomDebit ( / JEU I J lsBloc oEnt lsPoly PT oPoly lsVtx Vtx sHndProche sHnd dDist dDistMin dDistMaxRecherche iTotal iDebit)
 (setq dDistMaxRecherche 0.01)
 ; sélection des blocs et polylignes
 (if (setq JEU (ssget (list (cons 0 "INSERT,LWPOLYLINE"))))
   (progn
     (setq I 0)
     ; création de la liste des paires pointées (Handle . Point) pour les blocs
     ; et (Epaisseur . Handle) pour les polylignes
     (repeat (sslength JEU)
(setq oEnt (ssname JEU I))
(setq I (1+ I))
; si c'est un bloc
(if (= "INSERT" (cdr (assoc 0 (entget oEnt))))
  (progn
    (setq PT (cdr (assoc 10 (entget oEnt))))
    (setq lsBloc (append lsBloc (list (cons (cdr (assoc 5  (entget oEnt)))
				            (list (list (car PT) (cadr PT) 0.0))
				      )
			        )
	         )
    )
  )
  ; SI c'est un polyligne
  (setq lsPoly (append lsPoly (list (cons (cdr (assoc 39 (entget oEnt)))
				          (cdr (assoc 5  (entget oEnt)))
				    )
			      )
	       )
  )
)
     )

     ; tri de la liste des polyligne par épaisseure croissante
     (if lsPoly
(setq lsPoly (vl-sort lsPoly (function (lambda (e1 e2) (< (car e1) (car e2))))))
     )

     
     ; Boucle sur la liste des polylignes
     (setq K 0)
     (repeat (length lsPoly)
(setq oPoly (handent (cdr (nth K lsPoly))))
(setq K (1+ K))
   	(setq lsVtx (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget oPoly))))
(setq I 0)
(setq iTotal 0)
; boucle sur les Sommets
(repeat (length lsVtx)
  (setq Vtx (nth I lsVtx))
  (setq I (1+ I))
  (setq Vtx (list (car Vtx) (cadr Vtx) 0.0))
  (setq sHndProche nil)
  (setq dDistMin 1000000.0)
  ; boucle sur la liste des blocs pour trouver celui superposé au sommet
  (setq J 0)
  (while (and (< J (length lsBloc))
	      (>= dDistMin 0.00001) ;dDistMaxRecherche)
	 )
    (setq sHnd (car (nth J lsBloc)))
    (setq PT (cadr (nth J lsBloc)))
    (setq J (1+ J))
    (setq dDist (distance PT Vtx))
    (if (< dDist dDistMin)
      (setq dDistMin dDist
	    sHndProche sHnd)
    )
  )
  ; vérifie si la distance mini trouvée est bien inférieure à la distance maxi de recherche
  (if (> dDistMin dDistMaxRecherche)
    (setq sHndProche nil)
  )
  
  ; teste si bloc trouvé
  (if (not sHndProche)
    ; si bloc non trouvé ALORS dessine un cercle rouge calque 0
    (entmake (list (cons 0 "CIRCLE")
		   (cons 8 "0")
		   (cons 62 1)
		   (cons 10 Vtx)
		   (cons 40 0.5)
	     )
    )
    ; si bloc trouvé ALORS met à jour l'attribut T avec Q pour 1er bloc sinon Q+T précédent
    (progn
    (setq iDebit        (atoi (Vb-Val-att (handent sHndProche) "Q")))
    (setq iTotalCourant (atoi (Vb-Val-att (handent sHndProche) "T")))
    (if (= iTotalCourant 0)
      (setq iTotal (+ iTotal iDebit))
      (setq iTotal (+ iTotal iTotalCourant))
    )
    (Vb-Mod-att (handent sHndProche) "T" (itoa iTotal))
    )
  )
)
     )
     
   )
 )
)

    
;;                                                                                              
;;                                              fonctions                                                       
;;                                                                                              

;; Vb-Val-att fonction Vlisp pour lire la valeur d'un attribut
(defun Vb-Val-att (ent nomatt / att val); ent correspond au handel du bloc (codedxf 5) à utiliser comme ça  (setq toto (read (Vb-Val-att (handent handle) "REF")))
 (foreach att
       (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
       (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
 )
 val
 ;; retour de fonction
)
;;                                                                      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)
;;  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)
 )

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

Olivier

x_all · le 27 mai 2018

(rires forts)

plus la tête à lire ton code ni éplucher ton message mais le cœur y est, je viens de finir mon idée je la pose et dodo

le nouveau bloc est la

http://joch04.free.f...bit-ventil2.dwg

je sais que c'est pas optimisé, mais l'utilisation de case permet de traiter tous les cas qu'on peu imaginer pour d'autre utilisation,

j'ai repiqué le jeu de sélection des blocs avec la méthode de Didier, mais je croyais qu'elle ne sélectionnait que les blocs sur les point mais en fait non, il a quand même fallu trier avec les sommets... pas bien grave je vérifiai ça plus tard...


;;; Vsom Somme des débits sur une polyligne                                                  
;; utile pour la ventil Les blocs Debit joncsion sont disponible ici:                                       
;; http://joch04.free.fr/images/vrac/debit-ventil2.dwg      
;; cumule les Q dans l'attribut T à l'avancement d'une poly (le point 1 est                     
;; l'entrée d'air la plus éloignée de la source, le dernier point la source                                                        
;; dia est le diamètre théorique mini pour une vitesse 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 n pt lsvtx vtx ssblocs lsbloc bloc nombloc hbloc
       tcourant ta qa v)

				; 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)



 (setq ent (car (entsel "\nChoix de la polyligne\n")))

 (if (= "LWPOLYLINE" (cdr (assoc 0 (entget ent))))
   (setq lsvtx	(mapcar	'cdr
		(vl-remove-if-not
		  '(lambda (x) (= (car x) 10))
		  (entget ent)
		)
	)
   )
   (progn
     (alert "\nNe fonctionne qu'avec une POLYLIGNE")
     (exit)
   )
 )

				;création de la list des blocs
 (setq ssblocs (ssget "_f" lsvtx (list (cons 0 "INSERT"))))
 ;; pas bien compri comment ça marchait ton truc didier


 (setq i 0)
 (repeat (sslength ssblocs)
   (setq bloc	  (ssname ssblocs i)
  i	  (+ 1 i)
  PT	  (cdr (assoc 10 (entget bloc)))
  pt	  (reverse (cdr (reverse pt)))
  Vba-ent (vlax-ename->vla-object bloc)
  nombloc (vla-get-effectivename Vba-ent)

   )
   (foreach vtx lsvtx
     (if (equal vtx pt)
(setq lsBloc
       (append lsBloc
	       (list (cons nombloc
			   (cons (cdr (assoc 5 (entget bloc)))
				 pt
			   )
		     )
	       )
       )
)
     )
   )					;ff
 )					;fr					;fin setq lsbloc contient le nom du bloc le handle et une paire X/Y


 ;;                 Traiement des blocs


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

   (setq bloc	  (nth i lsbloc)
  nombloc (car bloc)
  hbloc	  (cadr bloc)
   )
   ;;test et mise a jour suivant le cas  
   (cond
     ((= i 0)
      (setq ta	      (read (Vb-Val-att (handent hbloc) "Q"))
     tcourant ta
      )
      (Vb-Mod-att (handent hbloc) "T" (rtos ta 2 0))
     )

     ((and (= nombloc "jonction") (/= (+ 1 i) (length lsbloc)))
      (setq qa	(read (Vb-Val-att (handent hbloc) "Q1"))
     ta	(+ tcourant qa)
      )
      (Vb-Mod-att (handent hbloc) "T" (rtos ta 2 0))
      (Vb-Mod-att (handent hbloc) "Q2" (rtos tcourant 2 0))
      (setq tcourant ta)
     )

     ((and (= nombloc "jonction") (= (+ i 1) (length lsbloc)))
      (setq qa	(read (Vb-Val-att (handent hbloc) "Q2"))
     ta	(+ tcourant qa)
      )
      (Vb-Mod-att (handent hbloc) "T" (rtos ta 2 0))
      (Vb-Mod-att (handent hbloc) "Q1" (rtos tcourant 2 0))
      (setq tcourant ta)
     )


     ((= nombloc "Debit")
      (setq qa	(read (Vb-Val-att (handent hbloc) "Q"))
     ta	(+ tcourant qa)
      )
      (Vb-Mod-att (handent hbloc) "T" (rtos ta 2 0))
      (setq d (rtos (sqrt (/ (* 4 ta) (* pi v 3600))) 2 2)
       ;;2 décimales on est en mètre
      )
      (Vb-Mod-att (handent hbloc) "DIA" d)
      (setq tcourant ta)
     )
     (t nil)
   )					;fc

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





 (print "sortie normale de Vsom")
 (princ)
)
;;fin Vsom




;;                                                                                              
;;                                              fonctions                                                       
;;                                                                                              

;; Vb-Val-att fonction Vlisp pour lire la valeur d'un attribut
(defun Vb-Val-att (ent nomatt / att val); ent correspond au handel du bloc (codedxf 5) à utiliser comme ça  (setq toto (read (Vb-Val-att (handent handle) "REF")))
 (foreach att
   (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
   (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
 )
 val
 ;; retour de fonction
)
;;                                                                      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)
;;  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)
 )

 (while (< inc (length vblst-att))
   (if	(eq (vla-get-tagstring (nth inc vblst-att)) nom-att)
     (vla-put-textstring (nth inc vblst-att) nval)
   )
   (setq inc (+ 1 inc))
 )
)					;
				; 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
)



;;

x_all · le 27 mai 2018

je comprend ton idée, mais je ne suis pas sur que ce soit pratique à l'usage car ça demande pas mal de manip, et c'est difficilement utilisable en conception pour qq1 qui maîtrise pas le programme. (et un des but c'est d'en faire profiter les collègues)

L'idée vue là ou on en est, c'est de faire du (defun c: une simple fonction qui parcours l'arbre toute seule le programme principal récursif l'appelant quand il détermine qu'il est sur une branche terminale ou que tous les bloc jonction non final qu'elle comporte ont été marqué (leur Q2 /=0).

j'en suis au stade ou c'est moi qui fait la récursivité en cliquant les poly une à une...

j'ai regardé l'algorithme de parcours d'un arbre. ( https://fr.wikipedia...s_en_profondeur )

je suis sur qu'il y a moyen de l'adapter

C'est peut être une question pour (gile) s'il passe par là.

(explorer (poly P jonction J)

il y a t il des jonctions intermédiaire non marquée ?

oui explorer poly sur la poly dont le dernier sommet est cette jonction

non lancer Vsom et donc marquer la poly

il faut en amont faire la liste des poly du calque du coup on peu passer directement les points en argument à Vsom

faudra que je teste...pour simplifier on va dire que les blocs et la poly sont dans un seul claque je vais tout trier comme ça.

Ton idée d'utiliser l'épaisseur, je la garde sous le coude. en dernier recours on fera comme ça. Mais il faudrait trouver moyen d'automatiser sa maintenance et ça revient à trouver une fonction récursive

didier · le 27 mai 2018

Coucou

On y prend goût ?

Au départ la question porte sur un truc pratique, basique

Sympa ... quelqu'un aurait une idée ??

On en est à l'exploration d'un arbre... on ne rigole plus (mais je comprends l'addiction)

À quand la commande vocale ? remplis-moi mes attributs (bien prononcé ça peut le faire...) (là c'est la diction)

Amicalement

x_all · le 27 mai 2018

oui, mais le truc basique marche, et avec deux méthodes... ça vaux le coup de pousser un peu la mémé, non?

Une première réflexion me démontre que c'est un peu plus compliqué que prévu pour la sélection des branches. j'avance doucement...

Et pour l'utilisation de Q2 comme marqueur je sais pas trop il doit y avoir moyen de parcourir une arborescence sans ça. En numérotant les branches?

et au passage faire une fonction qui peuple un réseau avec les bloc ad oc en début de conception avec une numérotation automatique des bouches regards etc.....

oui.. je m'emballe...

didier · le 27 mai 2018

Coucou

Tu as tout à fait raison, je disais ça juste pour la taquinerie

Perso je travaille aussi de cette façon, la première routine est basique

Puis vient le goût de l'automatisme et du challenge

Une de mes devises est quelque peu impérative (comme ma programmation) :

Je me contente du maximum

Amicalement

x_all · le 28 mai 2018

Bon, ben voila ou j'en suis pour cette 3ene version.

J'ai chercher à faire une liste de branche ou pour chaque poly je liste les triplets définissant un bloc.Je ne comprends pas encore bien pourquoi il ne veux pas me faire les cercle quand le dernier bloc est pas une jonction (ce qui indique que la poly est à inverser) mais c'est pas bien grave.ce qui reste à faire-réinitialiser les Qauxiliaure de tous les blocs "jonction" pendant la création de la liste

- réécrire une fonction Traitebranche qui calcule la branche (et donc renseigne Qauxiliaire sur la dernière jonction ce qui "marque la branche comme finie) ça, je devrai m'en sortir

C'est maintenant, que j'aimerai bien qu'un spécialise récurssif ( (gile) si tu traines par là ?) m'aide à faire la fonction qui parcours l'arbre...j'ai du mal à mettre en code cette idée...

Merci d'avance...

(édit ini de Qa et bug cercle corrigé)

(re edit du code..tourne pas...grrr)

;;; Vsom Somme des débits sur un arbre de  polylignes   V3-2                                       		
;; utile pour la ventil mais facile a adapter
;; Les blocs Debit et jonction sont disponible ici:                               		
;; http://joch04.free.fr/images/vrac/debit-ventil3.dwg      
;; cumule les Q dans l'attribut T à l'avancement d'une poly (le point 1 est             		
;; l'entrée d'air la plus éloignée de la source, le dernier point la source  ou jonction
;; chaque branche doit se terminer par une jonction 
;; T pour la jonction est la somme de Q branche courante + Q branche auxiliaire                                                      
;; dia est le diamètre théorique mini pour une vitesse 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      qa      qc      v   	doc
     	)




				; 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
 )

 (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 des qa des blocs jonctions leur calcul servant de marqueur pour le parcour des branches
 	(if (= "jonction" (car bloc))
   	(progn
     	(setq hbloc (caddr bloc))
     	(Vb-Mod-att (handent hbloc) "Qa" 0)
   	)				;fp
 	)				;fi
)				;fi
     )					;fe bloc
   )					;fe vtx
   (setq branche (reverse branche))
   ;;   (print branche)




   (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

 

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


;;                Explore                                                               		
;;                                                                                              
 (defun explore (lsbrlocal / brl bloc nok i)

   (setq brl (car lsbrlocal)
 	i   0
 	bloc nil
 	brl nil
     nok 0
   		)

   (while (< i (length brl))
     (setq bloc  (nth i brl)
   	hbloc (caddr bloc)
   	Qa  	(read (Vb-Val-att (handent hbloc) "Qa"))
     )
     (if (and (= 0 Qa) (/= (+ 1 i) (length lsbloc)))
;; test du Qa d'un bloc qui n'est pas le dernier 	si oui Nok = 1 
(setq nok 1)
     )
     (setq i (+ 1 ))
   )
   ;;ffe          on sais si la branche est traitable (nok=0)

   ;;   Si Qa non rempli, 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
   (if	(= nok 1)

     (progn
(setq lsbrlocal (append (cdr lsbrlocal) (list (car lsbrlocal))))
;; permutation à (gile)
(explore lsbrlocal)
     )
     ;;fp
   )
   ;;fi

   ;;                                                                                    
   ;; Si Nok = 0 la branche est traitable                                                
   ;; on traite, suprime cette branche de la collection et relance sur la nouvelle liste 

   (TraiteBranche brl)
   (if	(setq lsbrlocal (cdr lsbrlocal))

     (explore lsbrlocal)
   )

 )
;;;fd explore                                                                                
 

 

(explore lsbranche)





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




;;                                                                                              
;;                                              fonctions                               		
;;                                                                                              








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


(defun TraiteBranche (branche  / i u bloc hbloc tcourant ta)

 (setq	i    0
bloc nil
 )
 (while (< i (length branche))
   (setq bloc (nth branche i)
 	hbloc (caddr bloc))
   (Vb-Mod-att (handent hbloc) "Qa" (rtos 1 )  )
   
   );;;fw


)					;fd




;;;(defun TraiteBranche (branche index / i u bloc qa qc tcourant ta)
;;;
;;;  (setq	i    0
;;;	bloc nil
;;;  )
;;;  (while (< i (length lsbloc))
;;;
;;;    (setq bloc  	(nth i lsbloc)
;;;  	nombloc (x" bloc)
;;;  	hbloc  	(cadr bloc)
;;;    )
;;;    ;;test et mise a jour suivant le cas  
;;;    (cond
;;;      ((= i 0)
;;;   	(setq ta      	(read (Vb-Val-att (handent hbloc) "Q"))
;;;     	tcourant ta
;;;   	)
;;;   	(Vb-Mod-att (handent hbloc) "T" (rtos ta 2 0))
;;;      )
;;;
;;;      ((and (= nombloc "jonction") (/= (+ 1 i) (length lsbloc)))
;;;   	(setq qa	(read (Vb-Val-att (handent hbloc) "Q1"))
;;;     	ta	(+ tcourant qa)
;;;   	)
;;;   	(Vb-Mod-att (handent hbloc) "T" (rtos ta 2 0))
;;;   	(Vb-Mod-att (handent hbloc) "Q2" (rtos tcourant 2 0))
;;;   	(setq tcourant ta)
;;;      )
;;;
;;;      ((and (= nombloc "jonction") (= (+ i 1) (length lsbloc)))
;;;   	(setq qc	(read (Vb-Val-att (handent hbloc) "Qa"))
;;;     	ta	(+ tcourant qa)
;;;   	)
;;;   	(Vb-Mod-att (handent hbloc) "T" (rtos ta 2 0))
;;;   	(Vb-Mod-att (handent hbloc) "Q1" (rtos tcourant 2 0))
;;;   	(setq tcourant ta)
;;;      )
;;;
;;;
;;;      ((= nombloc "Debit")
;;;   	(setq qa	(read (Vb-Val-att (handent hbloc) "Q"))
;;;     	ta	(+ tcourant qa)
;;;   	)
;;;   	(Vb-Mod-att (handent hbloc) "T" (rtos ta 2 0))
;;;   	(setq d (rtos (sqrt (/ (* 4 ta) (* pi v 3600))) 2 2)
;;;       	;;2 décimales on est en mètre
;;;   	)
;;;   	(Vb-Mod-att (handent hbloc) "DIA" d)
;;;   	(setq tcourant ta)
;;;      )
;;;      (t nil)
;;;    )					;fc
;;;
;;;    (setq i (+ 1 i))
;;;  )					; fw
;;;
;;;
;;;)					;fd


;;           		Vb-Val-att fonction Vlisp pour lire la valeur d'un attribut                            
;;                                                                                                          
(defun Vb-Val-att (ent nomatt / att val); ent correspond au handel du bloc (codedxf 5) à utiliser comme ça  (setq toto (read (Vb-Val-att (handent handle) "REF")))
 (foreach att
  	(vlax-invoke (vlax-ename->vla-object ent) cv 'getattributes)
       (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
 )
 val
 ;; retour de fonction
)
;;                                                                      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)
;;  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)
 )

 (while (< inc (length vblst-att))
   (if	(eq (vla-get-tagstring (nth inc vblst-att)) nom-att)
     (vla-put-textstring (nth inc vblst-att) nval)
   )
   (setq inc (+ 1 inc))
 )
)					;
				; 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
)






;;

Connexion

somme des débits

Messages recommandés

Olivier Eckmann

Lien vers le commentaire

Partager sur d’autres sites

x_all

Lien vers le commentaire

Partager sur d’autres sites

Olivier Eckmann

Lien vers le commentaire

Partager sur d’autres sites

Olivier Eckmann

Lien vers le commentaire

Partager sur d’autres sites

x_all

Lien vers le commentaire

Partager sur d’autres sites

x_all

Lien vers le commentaire

Partager sur d’autres sites

didier

Lien vers le commentaire

Partager sur d’autres sites

x_all

Lien vers le commentaire

Partager sur d’autres sites

didier

Lien vers le commentaire

Partager sur d’autres sites

x_all

Lien vers le commentaire

Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante