De l\'aide pour une boucle

Morgul · le 18 septembre 2008

Bonjour à Tous,

J'ai enfin terminé mon Lisp de calcul de pertes de coax..

Toutefois, je ne suis pas satisfait de la manière dont on sélectionne les blocs.

En effet, on doit sélectionner les blocs à la souris, je souhaiterai que ce soit automatique.

Avec du genre :

(setq NomEntSel (ssget "X" (list (cons 2 "SYN_TAB*"))))
(setq NbEntSel (sslength NomEntSel))
(setq Cpt1 0)

Il faut donc créer une boucle, mais ça fait longtemps que j'en ai pas fait et je suis un peu perdu.

Voici mon Lisp actuel :

(defun c:CalculPertes (/ NomLsp BlocSel EntTamp NomBloc DefBloc EntBloc loop Val_Lg Val_GSM Val_DCS
                        Val_UMTS C1 C2 C3 bloc ent P1 P2 P3)



(setq NomLsp "Calcul_Pertes")

(princ (strcat "\n...Lancement du lisp \"" NomLsp "\"."))
(princ "\n...Version...1")
(princ "\n...")
(princ "\n...")


;                                    Début du programme


 (setq echo1 (getvar "cmdecho"))    ; svg cmdecho
 (setvar "cmdecho" 0)               ; 
 (setq lup1 (getvar "luprec"))      ; svg luprec
 (setvar "luprec" 6)                ; nombre de décimales


;                                                  Recherche du bloc


(setq BlocSel (ssget))  ;<<<<<<<<<<<< début de boucle à créer

(setq EntTamp (entget (ssname BlocSel 0)))
(setq NomBloc (cdr (assoc 2 EntTamp)))

      (if (= (cdr (assoc 0 EntTamp)) "INSERT")			; si l'entité est un bloc
       (progn


;                  Récupération de la valeur via l'étiquette de l'attribut constant


         (setq DefBloc (tblsearch "Block" NomBloc))
         (setq EntBloc (cdr (assoc -2 DefBloc)))
         (setq loop T)
         (while (and loop EntBloc)

           (setq NomEnt (entget EntBloc))
           (setq EntBloc (entnext EntBloc))

           (if (and (= (cdr (assoc 0 NomEnt)) "ATTDEF")
             (= (logand 2 (cdr (assoc 70 NomEnt))) 2)
             (= (cdr (assoc 2 NomEnt)) "COEF_GSM")		; l'étiquette en majuscules
             )
             (setq Val_GSM (cdr (assoc 1 NomEnt)))
           )

           (if (and (= (cdr (assoc 0 NomEnt)) "ATTDEF")
             (= (logand 2 (cdr (assoc 70 NomEnt))) 2)
             (= (cdr (assoc 2 NomEnt)) "COEF_DCS")		; l'étiquette en majuscules
             )
             (setq Val_DCS (cdr (assoc 1 NomEnt)))
           )

           (if (and (= (cdr (assoc 0 NomEnt)) "ATTDEF")
             (= (logand 2 (cdr (assoc 70 NomEnt))) 2)
             (= (cdr (assoc 2 NomEnt)) "COEF_UMTS")		; l'étiquette en majuscules
             )
             (setq Val_UMTS (cdr (assoc 1 NomEnt)))
           )

         ) ; while
           
         (setq loop nil)

         (setq C1 (atof Val_GSM))
         (setq C2 (atof Val_DCS))
         (setq C3 (atof Val_UMTS))

;                               Boucle sur les autres attributs


         (setq Ent_dansBloc 1)					; Drapeau attribut
         (while Ent_dansBloc					; tant qu'il y a des entités dans le bloc

; Nom de l'entité suivante dans le bloc

           (setq NomEnt (entget (entnext (cdr (assoc -1 EntTamp))))) 

; si cette entité est un attribut

           (if (= (cdr (assoc 0 NomEnt)) "ATTRIB") 
             (progn                 


;               Récupération et insertion des données via l'étiquette de l'attribut "..."


               (if (= (cdr (assoc 2 NomEnt)) "LG")		; si le nom de l'étiquette de l'attribut est
                 (progn
                   (setq Val_Lg (assoc 1 NomEnt))		; valeur de l'attribut (associée à 1)
                   (setq Val_Lg (cdr Val_Lg))			; récupération de la valeure de l'attribut
                   (setq LG (atoi Val_Lg))
                   (setq P1 (/ (* LG C1) 100))
                   (setq P1 (rtos P1 2 2))
                   (setq P1 (strcat P1 "dB"))
                   (setq P2 (/ (* LG C2) 100))
                   (setq P2 (rtos P2 2 2))
                   (setq P2 (strcat P2 "dB"))
                   (setq P3 (/ (* LG C3) 100))
                   (setq P3 (rtos P3 2 2))
                   (setq P3 (strcat P3 "dB"))
                 )                  				; progn
               )                    				; if



               (if (= (cdr (assoc 2 NomEnt)) "P_GSM")		; si le nom de l'étiquette de l'attribut est
                 (progn
	    (setq NomAtt (assoc 1 NomEnt))		; valeur de l'attribut (associée à 1)
	    (setq NewAtt (cons 1 P1))			; construction paire pointée)
	    (setq ChgAtt (subst NewAtt NomAtt NomEnt))	; remplace les valeurs
                   (entmod ChgAtt)				; modifie les données de l'attribut
                 )                  				; progn
               )                    				; if

               (if (= (cdr (assoc 2 NomEnt)) "P_DCS")		; si le nom de l'étiquette de l'attribut est
                 (progn
	    (setq NomAtt (assoc 1 NomEnt))		; valeur de l'attribut (associée à 1)
	    (setq NewAtt (cons 1 P2))			; construction paire pointée)
	    (setq ChgAtt (subst NewAtt NomAtt NomEnt))	; remplace les valeurs
                   (entmod ChgAtt)				; modifie les données de l'attribut
                 )                  				; progn
               )                    				; if

               (if (= (cdr (assoc 2 NomEnt)) "P_UMTS")		; si le nom de l'étiquette de l'attribut est
                 (progn
	    (setq NomAtt (assoc 1 NomEnt))		; valeur de l'attribut (associée à 1)
	    (setq NewAtt (cons 1 P3))			; construction paire pointée)
	    (setq ChgAtt (subst NewAtt NomAtt NomEnt))	; remplace les valeurs
                   (entmod ChgAtt)				; modifie les données de l'attribut
                 )                  				; progn
               )                    				; if



             )                      ; progn
           )                        ; if

           (if (= (cdr (assoc 0 NomEnt)) "SEQEND") 		; si on atteint la fin du bloc
             (setq Ent_dansBloc nil)
           ) 
           (setq EntTamp NomEnt)
         ) 			     ; retour à while
       )                            ; progn
     )                              ; if retour s'il y a encore des blocs


;                               Affichage des données extraites


(princ (strcat "\n...Données extraites :"))
(princ "\n...")
(princ (strcat "\n...Longueur = " Val_Lg "m"))
(princ (strcat "\n...Perte GSM  : " Val_Lg " x " Val_GSM  "/100 = " P1))
(princ (strcat "\n...Perte DCS  : " Val_Lg " x " Val_DCS  "/100 = " P2))
(princ (strcat "\n...Perte UMTS : " Val_Lg " x " Val_UMTS "/100 = " P3))
(princ "\n...")

 ;<<<<<<<<<<<< fin de boucle à créer

;                                     Fin du programme


   (setvar "cmdecho" echo1)
   (setvar "luprec" lup1)           ; nombre de décimales
   (terpri)
   (command "regntout") 
   (princ)



(princ)
) 
(c:CalculPertes)

bseb67 · le 18 septembre 2008

salut morgul

Petite question y a-t-il des blocs dynamiques?

Car les blocs dynamiques perdent leur noms d'origine pour devenir des *U....

Sinon, je pense que parcourir la liste des blocs

(tblnext "BLOCK" t) pour avoir le premier bloc, puis (tblnext "BLOCK" nil) pour passer au suivant

cela donne un truc de ce genre:

 
(setq premier t)

(while (setq Bloc (tblnext "BLOCK" premier))
    (setq premier nil)
 (setq NomEntSel (ssget "X" (list (cons 2 (cdr (assoc 2 Bloc))))))
(setq NbEntSel (sslength NomEntSel))
(setq Cpt1 0)
....

) ; while

Patrick_35 · le 18 septembre 2008

Salut

Pour parcourir ton jeu de sélection

(setq n 0)
(while (setq ent (ssname NomEntSel n))
blablabla
reblablabla
(setq n (1+ n))
)

@+

Morgul · le 18 septembre 2008

Merci les gars pour vos réponses, c'est sympa.

Mais, j'ai du mal m'exprimer, en fait je ne veux plus sélectionner manuellement.

Je voudrais que le Lisp trouve tout seul les blocs.

Du genre : (setq NomEntSel (ssget "X" (list (cons 2 "SYN_TAB*"))))

Je n'arrive pas à remplacer les lignes suivantes pour que mon Lisp puisse continuer de fonctionner :

(setq BlocSel (ssget))

(setq EntTamp (entget (ssname BlocSel 0)))

(setq NomBloc (cdr (assoc 2 EntTamp)))

Merci encore.

bonuscad · le 18 septembre 2008

La réponse de Patrick_35 est pourtant ce qu'il faut faire. :casstet:

Il faut même en faire une seconde si tu veux extraire les attributs

L'exemple ramené à ce que tu demande (à copier-coller en ligne de commande)

((lambda ( / )

(vl-load-com)

(setq BlocSel (ssget "_X" (list (cons 2 "SYN_TAB*"))) n 0)

(sssetfirst nil BlocSel)

(while (setq NomEnt (ssname BlocSel n))

(setq vla_obj (vlax-ename->vla-object NomEnt) NomAtt NomEnt)

(if (not (zerop (vlax-get vla_obj 'HasAttributes)))

(while (/= (vlax-get (setq vla_obj (vlax-ename->vla-object (setq NomAtt (entnext NomAtt)))) 'ObjectName) "AcDbSequenceEnd")

(print (vlax-get vla_obj 'TextString))

)

(setq n (1+ n))

)

))

Patrick_35 · le 18 septembre 2008

Salut Bonus

Comme tu commences à bien tâter du vla, je vais t'indiquer, si tu le permets, deux ou trois choses ;)

Tu peux éviter un test avec HasAttributes car un (vlax-invoke vla_obj 'getattributes) te donne une liste avec les attributs du bloc.

S'il n'y a pas d'attributs, pas de liste.

Pour la boucle, tu peux utiliser un vlax-for ou vlax-map-collection en utilisant le jeu de sélection stocké sous forme vla par ce biais

(setq sel (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))

Et cela évite en plus de transformer un ename en vla-object.

ps : ne pas oublier de faire un (vla-delete sel) à la fin pour éviter de futurs plantages lors d'un simple ssget

Trois exemples.

Pour changer la valeur de tous les attributs avec "Mon_Texte".

(vl-load-com)
(ssget "_X" (list (cons 2 "SYN_TAB*")))
(vlax-for ent (setq sel (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
 (foreach att (vlax-invoke ent 'getattributes)
   (vla-put-textstring att "Mon_Texte")
 )
)
(vla-delete sel)

Pour changer seulement le premier attribut.

(vl-load-com)
(ssget "_X" (list (cons 2 "SYN_TAB*")))
(vlax-for ent (setq sel (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
 (vla-put-textstring (car (vlax-invoke ent 'getattributes)) "Mon_Texte")
)
(vla-delete sel)

Le même que le second mais en utilisant vlax-map-collection à la place du vlax-for.

(vl-load-com)
(ssget "_X" (list (cons 2 "SYN_TAB*")))
(vlax-map-collection (setq sel (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
 '(lambda(x) (vla-put-textstring (car (vlax-invoke x 'getattributes)) "Mon_Texte"))
)
(vla-delete sel)

Pas toujours facile à comprendre, surtout au début, mais plus simple qu'autolisp, plus court et plus rapide et cela évite les boucles avec entnext et le seqend.

@+

bonuscad · le 18 septembre 2008

Comme tu commences à bien tâter du vla

Mouais! , Y a encore du boulot!

En tout cas merci pour le cours ;)

cela évite les boucles avec entnext et le seqend.

C'est sur!

Je vais essayer de réécrire le code en tenant compte de tes observations, cela me fera "tâter" du vla-sexy :P

Morgul · le 18 septembre 2008

Merci à vous, de faire marcher vos cellules grises pour un nul comme moi ....

En fait, ma demande était in-adaptée, et j'ai trouvé plus simple d'utiliser repeat.

En plus, bseb67 avait raison, j'utilisais des blocs que je ne croyait pas dynamique, mais en fait ils l'étaient devenus car j'avais créé un paramètre de Pt d'insertion.

Du coup, mon Lisp ne les voyait pas.

Bref, je suis un naze, mais le principale, c'est que ça tourne maintenant.

Merci encore pour tout.

bseb67 · le 19 septembre 2008

pour un nul comme moi ...

mais non morgul, il faut te juste comprendre et que tes neurones ont un peu de place

pour stocker les infos. ;)

En fait je pensais que tu voulais faire quelque chose sut tous les blocs du dessin.

D'où le tblnext, en plus il te choppe bien les blocs en *U que la commande insérer

elle ne voit (ou plutot ne te montre pas). mais le ssget ne marche pas avec en direct :(

enfin bref.

En fait, ma demande était in-adaptée, et j'ai trouvé plus simple d'utiliser repeat.

Toujours le problème de communication, ca me fait toujours penser à la citation dans un bouquin à werber:

Entre

Ce que je pense

Ce que je veux dire

Ce que je crois dire

Ce que je dis

Ce que vous avez envie d’entendre

Ce que vous croyez entendre

Ce que vous entendez

Ce que vous avez envie de comprendre

Ce que vous croyez comprendre

Ce que vous comprenez

Il y a dix possibilités qu’on ait des difficultés à communiquer.

Mais essayons quand même…

mais le principale, c'est que ça tourne maintenant.

tant mieux si ca marche :)

a+

[Edité le 19/9/2008 par bseb67]

bonuscad · le 19 septembre 2008

Je vais essayer de réécrire le code en tenant compte de tes observations

plus simple qu'autolisp, plus court et plus rapide

Je me suis entrainé sur ce sujet sur le forum autodesk (il y a un fichier exemple), et c'est vrai que c'est plus rapide, pour la simplicité c'est pas évident..

voici le code que j'ai appliqué (le but était de mettre le Z d'insertion du bloc sur la valeur d'un attribut)

((lambda ( / sel vla_obj val_att)
(vl-load-com)
(ssget "_X" (list (cons 2 "point")))
(vlax-map-collection (setq sel (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
	'(lambda(x)
     (cond
       ((and (setq vla_obj (car (vlax-invoke x 'getattributes))) (eq (vla-get-tagstring vla_obj) "ELEV"))
         (setq val_att (vla-get-textstring vla_obj))
				(if (vl-string-search "," val_att)
           (setq val_att (vl-string-subst "." "," val_att))
         )
				(if (eq (type (read val_att)) 'REAL)
					(vlax-put-property x 'InsertionPoint
						(vlax-safearray-fill (vlax-variant-value (vlax-get-property x 'InsertionPoint))
							(list
								(car (vlax-safearray->list (vlax-variant-value (vlax-get-property x 'InsertionPoint))))
								(cadr (vlax-safearray->list (vlax-variant-value (vlax-get-property x 'InsertionPoint))))
								(atof val_att)
							)
						)
					)
				)
			)
		)
	)
)
(vla-delete sel)
))

Par contre je ne sais pas si c'est mon code ou les bloc du dessin qui ont un problème, il y a le Z de certain attributs qui se déplace sur la valeur double de l'insertion du bloc???

Merci encore pour l'exercice. J'ai eu un peu de mal à le monter.

Encore des erreurs/remarques?

Patrick_35 · le 19 septembre 2008

Très bien Bonus :D

pour la simplicité c'est pas évident..

C'est bien ce que je disais, au début c'est pas simple. C'est une logique à prendre ;)

Sinon,

Pour définir un point 3D en vla, tu as la fonction (vlax-3d-point ...)

Pour donner directement les coordonnées, tu peux utiliser (vlax-put ... 'InsertionPoint)

Et pour récupérer directement des coordonnées, tu peux utiliser (vlax-get ... 'InsertionPoint)

Donc

(vlax-put-property x 'InsertionPoint
(vlax-safearray-fill (vlax-variant-value (vlax-get-property x 'InsertionPoint))
(list
(car (vlax-safearray->list (vlax-variant-value (vlax-get-property x 'InsertionPoint))))
(cadr (vlax-safearray->list (vlax-variant-value (vlax-get-property x 'InsertionPoint))))
(atof val_att)
)
)
)

pourrait être remplacé par

(vlax-put x 'InsertionPoint (list
		      (car (vlax-get x 'InsertionPoint))
		      (cadr (vlax-get x 'InsertionPoint))
		      (atof val_att)
		    )
)

il y a le Z de certain attributs qui se déplace sur la valeur double de l'insertion du bloc???

Cela doit venir du dessin, car je ne vois rien qui cloche au niveau du code.

J'ai eu un peu de mal à le monter.

Ca va venir, ca va venir.

Enfin un roi du lisp qui passe à la vitesse supèrieure :D

@+

bonuscad · le 19 septembre 2008

Pour donner directement les coordonnées, tu peux utiliser (vlax-put ... 'InsertionPoint)

Pfouu!! J'ai tourné un moment à trouver la forme, et qu'en je l'ai essayé, ça n'a pas fonctionné!

Donc je m'était tourné vers une autre forme. J'ai du "m...de".

Cela me manque quand même; un fichier d'aide comme cela est présenté pour les autres fonctions autolisp basic.

Je sais que l'on retrouve la forme dans l'aide VBA, mais je m'y perd un peu à cause de la forme.

Et puis les fonctions tellement nombreuses et les différentes manières a manipuler les données.

Je me mélange un peu les pinceaux entre ces deux manières.... (c'est un peu comme ci on avait 2 manières de faire un (entget))

Mais au fur et à mesure de voir des petits bouts code mettant en évidence ces subtilités, ça devrait aller. ;)

Bruno_T · le 20 septembre 2008

En effet, on doit sélectionner les blocs à la souris, je souhaiterai que ce soit automatique.

Avec du genre :

(setq NomEntSel (ssget "X" (list (cons 2 "SYN_TAB*"))))
(setq NbEntSel (sslength NomEntSel))
(setq Cpt1 0)

bonjour,

pour faire une sélection globale des blocs dont les noms commencent par "SYN_TAB" :

[b] (ssget "X" '((0 . "insert") (2 . "SYN_TAB*")))[/b]

bon week

Bruno Toniutti

[Edité le 20/9/2008 par Bruno_T]

Connexion

De l\'aide pour une boucle

Messages recommandés

Morgul

bseb67

Patrick_35

Morgul

bonuscad

Patrick_35

bonuscad

Morgul

bseb67

bonuscad

Patrick_35

bonuscad

Bruno_T

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante