Sélectionner des blocs pour extraire les valeurs d\'attributs

[Tagazin]

Bonjour à tous,

 

Je voudrais sélectionner des blocs à la souris et extraire les valeurs d'attributs qu'il contiennent.

J'ai fait un premier lisp, mais il ne me plait pas :

 

(defun c:imp ()

(alert "Sélectionnez les étiquettes des câbles composant le tronçon")
(setq Select (ssget))
(setq NbrSel (sslength Select))	          ;cpte le nbre de sélection
(setq NbSel (itoa NbrSel))
(setq compt 0)
(setq LGT 0)
(setq P1T 0)
(setq P2T 0)
(setq P3T 0)

;;; début while 0

(while (< compt NbrSel)
(setq b  (ssname Select compt))
(setq b2 (ssname Select compt))
(setq latt1 (cons latt latt1))	          ;lst étiquettes attrib
(setq latt nil)
(setq att2 nil)

;;; début while-1

(while (/= att2 "SEQEND")
(setq b2 (entnext b2))
(setq x2 (entget  b2))
(setq att2   (cdr (assoc 0 x2)))
(setq att20  (cdr (assoc 1 x2)))
(setq latt21 (cons att20 latt21)))

;;; fin while-1

(setq LG (strcat (nth 4 latt21)))	; Extraction de "LG"
(setq LG (atof LG))
(setq LGT (+ LG LGT))

(setq P1 (strcat (nth 3 latt21)))	; Extraction de "P1"
(if (= P1 "-")
(setq P1 0)
(progn
(setq NBR1 (- (strlen P1) 2))
(setq P1 (substr P1 1 NBR1))
(setq P1 (atof P1))
)
)
(setq P1T (+ P1 P1T))



(setq P2 (strcat (nth 2 latt21)))	; Extraction de "P2"
(if (= P2 "-")
(setq P2 0)
(progn
(setq NBR2 (- (strlen P2) 2))
(setq P2 (substr P2 1 NBR2))
(setq P2 (atof P2))
)
)
(setq P2T (+ P2 P2T))



(setq P3 (strcat (nth 1 latt21)))	; Extraction de "P3"
(if (= P3 "-")
(setq P3 0)
(progn
(setq NBR3 (- (strlen P3) 2))
(setq P3 (substr P3 1 NBR3))
(setq P3 (atof P3))
)
)
(setq P3T (+ P3 P3T))



(setq latt21 nil)
(setq compt (+ 1 compt)))

;;; fin while 0

(setq LGT (rtos LGT 2 2))
(setq P1T (rtos P1T 2 2))
(setq P2T (rtos P2T 2 2))
(setq P3T (rtos P3T 2 2))

(princ "\n...")
(princ (strcat "\n...Vous avez sélectionnez     : " NbSel " blocs"))
(princ (strcat "\n...Longueur totale du tronçon : " LGT "m"))


(if (= P1T "0.00")
(progn
(setq P1T "-")
(princ (strcat "\n...Totale 1        : " P1T))
)
(princ (strcat "\n...Totale 1         : -" P1T "dB"))
)


(if (= P2T "0.00")
(progn
(setq P2T "-")
(princ (strcat "\n...Totale 2         : " P2T))
)
(princ (strcat "\n...Totale 2         : -" P2T "dB"))
)


(if (= P3T "0.00")
(progn
(setq P3T "-")
(princ (strcat "\n...Totale 3         : " P3T))
)
(princ (strcat "\n...Totale 3         : -" P3T "dB"))
)


(Princ)
)
(c:imp) 

 

Ce qui ne me plait pas c'est :

 

;;; début while-1

 

(while (/= att2 "SEQEND")

(setq b2 (entnext b2))

(setq x2 (entget b2))

(setq att2 (cdr (assoc 0 x2)))

(setq att20 (cdr (assoc 1 x2)))

(setq latt21 (cons att20 latt21)))

 

;;; fin while-1

 

(setq LG (strcat (nth 4 latt21))) ; Extraction de "LG"

(setq LG (atof LG))

(setq LGT (+ LG LGT))

 

(setq P1 (strcat (nth 3 latt21))) ; Extraction de "P1"

 

....

 

(setq P2 (strcat (nth 2 latt21))) ; Extraction de "P2"

 

....

 

(setq P3 (strcat (nth 1 latt21))) ; Extraction de "P3"

 

 

Car si je sélectionne un mauvais bloc ça plante et puis il faut que les attributs restent dans le bon ordre, sinon cela va me faire des erreurs de calculs sur les valeurs extraites.

 

Pour reconnaitre les bons attributs, je préfairerais un truc du genre :

; retourne dans EntTamp la liste des données du numéro Cpt1 de TouBloc

(setq EntTamp (entget (ssname TouBloc Cpt1))) 
(setq Cpt1 (+ Cpt1 1))				; incrémente le compteur de blocs
                             
(if (= (cdr (assoc 0 EntTamp)) "INSERT")		; si l'entité est un bloc
(progn
(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))))) 

(if (= (cdr (assoc 0 NomEnt)) "ATTRIB")     ; si cette entité est un attribut
(progn                 


(if (= (cdr (assoc 2 NomEnt)) "P_GSM")	; si le nom de l'étiquette...
progn
(setq NomAtt (assoc 1 NomEnt))		; valeur de l'attribut (associée à 1)
(setq P1 NomAtt)
(setq P1 (cdr P1))			; récupération de la valeure de l'attribut
)                  				; progn
)                    				; if


(if (= (cdr (assoc 2 NomEnt)) "P_DCS")	; si le nom de l'étiquette...
progn
(setq NomAtt (assoc 1 NomEnt))		; valeur de l'attribut (associée à 1)
(setq P2 NomAtt)
(setq P2 (cdr P2))			; récupération de la valeure de l'attribut
)                  				; progn
)                    				; if


(if (= (cdr (assoc 2 NomEnt)) "P_UMTS")	;si le nom de l'étiquette...
progn
(setq NomAtt (assoc 1 NomEnt))		; valeur de l'attribut (associée à 1)
(setq P3 NomAtt)
(setq P3 (cdr P3))			; récupération de la valeure 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

Mais je n'arrive pas à faire l'assemblage.

Merci pour votre aide.