Lister l'ensemble des calques

[Olivier_CEA_Grenoble]

Bonjour

 

Je suis en cour de rédaction d'un LISP qui scrute l'ensemble de fichiers via TBLNEXT

 

Mais, j'ai le souci suivant, quand je passe le TBLNEXT

(cdr(assoc 2 (tblnext "LAYER")))

manuellement, j'ai bien intégrité de mes calques qui défile, mais quand je le place dans une boucle while

       (while (/= (tblnext "LAYER") nil)
	(write-line(cdr(assoc 2 (tblnext "LAYER")))fich_log)
)

je n'ai pas l'intégrité de mes calques :blink:

[Patrick_35]

Salut

 

Pour pointer sur le 1er calque

(tblnext "layer" t)

 

@+

[VDH-Bruno]

Bonjour,

Oui comme cela tu obtiens un calque sur deux (2 tblnext dans chaque itération)

Mémorise le tblnext de ton while pour la fonction assoc qui suit

A+

[VDH-Bruno]

Re,

 

Un exemple pour le principe

(while (setq l (tblnext "layer" (not l))) (princ (strcat "\n" (cdr (assoc 2 l)))))

A+

[Patrick_35]

Ou encore

 

(setq cal (tblnext "layer" t))
(while cal
 (write-line (cdr (assoc 2 cal)) fich_log)
 (setq cal (tblnext "layer"))
)

 

@+

[VDH-Bruno]

Ou bien en Vlisp avec une boucle vlax-for

(vlax-for l (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
 (princ (strcat "\n" (vla-get-Name l)))
)

 

Ou comme ceci

(vlax-map-collection
 (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
 '(lambda (l) (princ (strcat "\n" (vla-get-Name l))))
)

 

Voilà pour les "grands" classiques

A+

[Patrick_35]

Ou bien en Vlisp avec une boucle vlax-for

(vlax-for l (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
 (princ (strcat "\n" (vla-get-Name l)))
)

 

Ou comme ceci

(vlax-map-collection
 (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
 '(lambda (l) (princ (strcat "\n" (vla-get-Name l))))
)

 

Voilà pour les "grands" classiques

A+

Bravo :D

 

D'habitude, tu reponds en autolisp et moi en vlisp. Là c'est le contraire :(rires forts):

 

@+

[Olivier_CEA_Grenoble]

Super et merci Patrick_35' :D

Mon fichier de log s'enrichi gentiment

 

 

 

(setq cal (tblnext "layer" t))
(while cal
 (write-line (cdr (assoc 2 cal)) fich_log)
 (setq cal (tblnext "layer"))
)

 

@+

[Patrick_35]

Super et merci Patrick_35' :D

Mon fichier de log s'enrichi gentiment

 

 

 

(setq cal (tblnext "layer" t))
(while cal
 (write-line (cdr (assoc 2 cal)) fich_log)
 (setq cal (tblnext "layer"))
)

 

@+

N'oublie pas aussi de remercier Bruno, qui a pris la peine de te lire et de te répondre.

Regarde aussi ses réponses, elles sont pleines d'enseignements.

 

@+

[Olivier_CEA_Grenoble]

Effectivement Patrick_35,

 

Merci aussi a VDH-Bruno pour sont analyse ou effectivement je me plantai magnifiquement, de plus je devais tomber sur une erreur non visible vue que noyer dans le déroulement du lisp.

 

donc un grand merci a VDH-Bruno

 

Olivier

[VDH-Bruno]

Re,

 

, de plus je devais tomber sur une erreur non visible vue que noyer dans le déroulement du lisp.

L'erreur "non visible" que tu mentionnes avec la ligne de code que tu as posté, est fonction du nombre de calques (paire ou impaire), donc en sortie de boucle soit tu passais en argument à la fonction write-line un nom de calque ou bien nil, ce qui devait te renvoyé pour ce dernier un message d'erreur du type:

; erreur: type d'argument incorrect: stringp nil

 

Sinon pour la "réponse pleine d'enseignement", Patrick_35 doit faire allusion à cette ligne de code (setq l (tblnext "layer" (not l))) juste après le while, une façon élégante de toujours pointer sur le premier calque, et de remettre la variable à nil en sortie de boucle.

Cette expression est aussi un "grand classique", dont je ne suis pas l'auteur, je l'ai remarqué il me semble pour la première fois dans un code de (gile).

 

D'habitude, tu reponds en autolisp et moi en vlisp. Là c'est le contraire

Oui, et si ça continue tu va tout coder en récursif, même quand ce n'est pas justifié. :D

 

A+

[Olivier_CEA_Grenoble]

Bien, voilà ce que j'ai pondue.

;;________ Etablir la liste des calques, blocs et présentations d'un fichier.
(defun c:Balay(/ log_publication fich_log ListPres cal bl SCUS)
;;_____ Ouverture fichier LOG  
(setq log_publication (strcat "x:\\Log\\" (rtos(getvar "DATE")) ".log"))
(setvar "luprec" 6)
(setq fich_log (open log_publication "W"))
;;_____ Ecriture des valeurs de collection
(write-line(getvar "dwgname") fich_log)
(write-line (strcat "Date de création du fichier :" (def_date(getvar "tducreate"))) fich_log)
(write-line(strcat "Date de Balayage fichier :" (def_date(getvar "DATE"))) fich_log)
(write-line "______________________________________" fich_log)
(write-line "Liste des presentations:" fich_log)
(setq ListPres (layoutlist))
(while (/= ListPres nil)
	(write-line (car ListPres) fich_log)
	(setq ListPres (cdr ListPres))
)
(write-line "______________________________________" fich_log)
(write-line "Liste des calques:" fich_log)
(setq cal (tblnext "layer" t))
(while cal 
	(write-line (cdr (assoc 2 cal)) fich_log)
	(setq cal (tblnext "layer"))
)
(write-line "______________________________________" fich_log)
(write-line "Liste des Blocks :" fich_log)
(setq bl (tblnext "BLOCK" t))
(while bl
	(write-line  (cdr(assoc 2 bl)) fich_log)
	(setq bl (tblnext "BLOCK"))
)
(write-line "______________________________________" fich_log)
(write-line "Liste des SCU :" fich_log)
(setq SCUS (tblnext "UCS" t))
(while SCUS
	(write-line  (cdr(assoc 2 SCUS)) fich_log)
	(setq SCUS (tblnext "UCS"))
)
(close fich_log)
(command "START" log_publication)
)
(defun def_date (td / j y d m)
       (setq
   j (- (fix td) 1721119.0)
   y (fix (/ (1- (* 4 j)) 146097.0))
   j (- (* j 4.0) 1.0 (* 146097.0 y))
   d (fix (/ j 4.0))
   j (fix (/ (+ (* 4.0 d) 3.0) 1461.0))
   d (- (+ (* 4.0 d) 3.0) (* 1461.0 j))
   d (fix (/ (+ d 4.0) 4.0))
   m (fix (/ (- (* 5.0 d) 3) 153.0))
   d (- (* 5.0 d) 3.0 (* 153.0 m))
   d (fix (/ (+ d 5.0) 5.0))
   y (+ (* 100.0 y) j)
	)		
       (if (< m 10.0)
               (setq m (+ m 3))
               (setq m (- m 9) y (1+ y))
       )
       (strcat(itoa (fix d))"."(itoa (fix m))"."(itoa (fix y)))
)

 

Merci a vous tous :)

http://images.all-free-download.com/images/graphiclarge/beer_89581.jpg

[VDH-Bruno]

Bien, voilà ce que j'ai pondue.

Merci d'avoir partagé ton code, éventuellement pense à factoriser les portions de codes répétitives.

[VDH-Bruno]

Oui, et si ça continue tu va tout coder en récursif, même quand ce n'est pas justifié. :D

Voici également ce que j'ai pondu sur ce thème, une version récursive une peut plus généraliste, récursive qui ne ce justifie pas forcément :(rires forts):

;;; TBLNEXTLIST                                                                              VDH-Bruno
;;; Retourne la liste les noms de symboles correspondant aux appels successifs à la fonction tblnext
;;; Argument
;;;   n -> Nom de table ("LAYER" "LTYPE" "VIEW" "STYLE" "BLOCK" "UCS" "APPID" "DIMSTYLE" "VPORT")
;;;   f -> Si f (flag) est non nil, TBLLIST retourne tous les nom depuis la première entrée
(defun tblnextlist (n f)
 (if (setq f (tblnext n f))
   (cons (cdr (assoc 2 f)) (tblnextlist n nil)))) 

 

Ci dessous des fonctions plus spécifique qui retourne une liste sur le même modèle que la fonction (layoutlist), (code reprenant le modèle du code de "vue pavée" de (gile))

;;; Ensemble de fonctions pour lister les noms de symboles des tables               VDH-Bruno
;;; (LAYERLIST) -> Retourne la liste des Noms de calque
;;; (LTYPELIST) -> Retourne la liste des Noms de type de ligne
;;; (VIEWLIST)  -> Retourne la liste des Noms de vue
;;; (STYLELIST) -> Retourne la liste des Noms de style de texte
;;; (BLOCKLIST) -> Retourne la liste des Noms de bloc ou nil
;;; (UCSLIST)   -> Retourne la liste des Noms de SCU ou nil
;;; (APPIDLIST) -> Retourne la liste des Noms d'application ou nil
;;; (DIMSTYLELIST)-> Retourne la liste des Noms de style de cote
;;; (VPORTLIST) -> Retourne la liste des Noms de fenêtre ou nil
(mapcar
 '(lambda (tbl)
    (eval (list 'defun (read (strcat tbl "list")) nil (list 'tblnextlist tbl T)))
  )
 '("LAYER" "LTYPE" "VIEW" "STYLE" "BLOCK" "UCS" "APPID" "DIMSTYLE" "VPORT")
)

 

A+

[Olivier_CEA_Grenoble]

Merci d'avoir partagé ton code, éventuellement pense à factoriser les portions de codes répétitives.

:blink: ? les portions de code répétitives, je vois bien mais factoriser?

 

Merci pour les *list type layoutlist que je ne connaissais pas.

 

Olivier

[Patrick_35]

Oui, et si ça continue tu va tout coder en récursif, même quand ce n'est pas justifié. :D

Je préfère les itératives, plus simple et plus fiable à mon gout.

Cela n'empêche pas que des récursives s'imposent quand on fait une recherche de type arborescence (répertoires, blocs imbriqués, ...)

 

ps : je vois que deviens une pointure en lisp, même si c'est inspiré à l'origine de (gile).

 

:blink: ? les portions de code répétitives, je vois bien mais factoriser?

Ben, quand on lit ça

(setq bl (tblnext "BLOCK" t))
(while bl
 (write-line  (cdr(assoc 2 bl)) fich_log)
 (setq bl (tblnext "BLOCK"))
)
(setq SCUS (tblnext "UCS" t))
(while SCUS
 (write-line  (cdr(assoc 2 SCUS)) fich_log)
 (setq SCUS (tblnext "UCS"))
)

 

on peut très bien imaginer une sous-routine

(defun ecrire_table(tbl / ele)
 (setq ele (tblnext tbl t))
 (while ele
   (write-line  (cdr (assoc 2 ele)) fich_log)
   (setq ele (tblnext tbl))
 )
)

 

appellé par

(ecrire_table "BLOCK")
(ecrire_table "UCS")

Ou

(foreach ele '("BLOCK" "UCS")
 (ecrire_table ele)
)

Ou

(mapcar 'ecrire_table '("BLOCK" "UCS"))

 

@+

[VDH-Bruno]

Bonjour,

 

Devancé par Patrick_35, mais bon ma réponse étant faites, je la livre tout de même..

:blink: ? les portions de code répétitives, je vois bien mais factoriser?

Merci pour les *list type layoutlist que je ne connaissais pas.

J'ai dit éventuellement ce n'est pas une obligation, la factorisation consiste à repérer les portions de codes identiques, afin d'en faire des fonctions réutilisablent.

 

Le code dans ma réponse 14 en est une illustration poussé à l'extrême, qui crée les fonctions *list type layoutlist, lorsque ces lignes de codes sont charger en mémoire.

 

Pour l'exemple en regardant ton code on voit que 3 sections sont identiques ("Liste des calques" " Liste des Blocks" "Liste des SCU") et si on travaille avec les fonctions nouvellement créé (LAYERLIST) (BLOCKLIST) (UCSLIST) ce sont 4 sections de code identique avec la "Liste des presentations".

 

Pour faire la factorisation de ton code, on extrait la partie semblable

(write-line "______________________________________" fich_log)
(write-line "Liste des presentations:" fich_log)
(setq ListPres (layoutlist))
(while (/= ListPres nil)
 (write-line (car ListPres) fich_log)
 (setq ListPres (cdr ListPres))
)

 

On lui donne un nom de fonction et on remplace par des variables les éléments qui changent, ce qui donne ceci:

;; Ecrit dans un fichier une liste de chaines de caractères
(defun write_list_str (texte liststr descfich)
 (write-line "______________________________________" descfich)
 (write-line texte descfich)
 (while (/= liststr nil)
   (write-line (car liststr) descfich)
   (setq liststr (cdr liststr))
 )
)

 

Maintenant dans le corps du code principal, on rappel la nouvelle fonction en lui passant en arguments les variables, ce qui pourrait donner la réécrit suivante:

(defun c:Balay (/ log_publication fich_log ListPres cal bl SCUS)
 ;;_____ Ouverture fichier LOG  
 (setq log_publication (strcat "x:\\Log\\" (rtos (getvar "DATE")) ".log"))
 (setvar "luprec" 6)
 (setq fich_log (open log_publication "W"))
 ;;_____ Ecriture des valeurs de collection
 (write-line (getvar "dwgname") fich_log)
 
 (write-line (strcat "Date de création du fichier :" (def_date (getvar "tducreate"))) fich_log)
 (write-line (strcat "Date de Balayage fichier :" (def_date (getvar "DATE"))) fich_log)
 (write_list_str "Liste des presentations:" (layoutlist) fich_log) ;Liste des presentations
 (write_list_str "Liste des calques:" (layerlist) fich_log) ; Liste des calques
 (if (setq bl (blocklist)) ; Liste des Blocks
   (write_list_str "Liste des Blocks:" bl fich_log)
 ) 
 (if (setq SCUS (ucslist)) ) ; Liste des SCU
   (write_list_str "Liste des SCU:" SCUS fich_log)
 ) 
 
 (close fich_log)
 (command "START" log_publication)
)

 

A+

[VDH-Bruno]

Je préfère les itératives, plus simple et plus fiable à mon gout.

Oui parler de gout résume toute la question, néanmoins j'aime bien les récursives, je pense que c'est une excellente gymnastique cérébrale tout à fait adapté au lisp.

 

ps : je vois que deviens une pointure en lisp, même si c'est inspiré à l'origine de (gile).

C'est vrai que je lui ai beaucoup emprunté, donc il me semble honnête de le citer lorsque j'utilise sur les forums des lignes de codes qu'il m'a inspiré, plutôt que de m'attribuer un mérite qui ne me reviens pas..

 

Amicalement,

(Ps: Si dans ma programmation, je faisais plus de vlisp, ou sortais plus de l'application, tu serais évidemment cité d'avantage ;) )

[Olivier_CEA_Grenoble]

Ok je vais m’efforcer de réfléchir dans ce sens qui allégera gentiment mes lisp.

 

Cordialement

Olivier