Lister l'ensemble des calques

Olivier_CEA_Grenoble · le 5 février 2015

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 · le 5 février 2015

Salut

Pour pointer sur le 1er calque

(tblnext "layer" t)

@+

VDH-Bruno · le 5 février 2015

Bonjour,

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

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

A+

VDH-Bruno · le 5 février 2015

Re,

Un exemple pour le principe

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

A+

Patrick_35 · le 5 février 2015

Ou encore

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

@+

VDH-Bruno · le 5 février 2015

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 · le 5 février 2015

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 · le 5 février 2015

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 · le 5 février 2015

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 · le 5 février 2015

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 · le 5 février 2015

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 · le 5 février 2015

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 · le 5 février 2015

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 · le 5 février 2015

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 · le 6 février 2015

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 · le 6 février 2015

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 · le 6 février 2015

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 · le 6 février 2015

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 · le 6 février 2015

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

Cordialement

Olivier

Connexion

Lister l'ensemble des calques

Messages recommandés

Olivier_CEA_Grenoble

Patrick_35

VDH-Bruno

VDH-Bruno

Patrick_35

VDH-Bruno

Patrick_35

Olivier_CEA_Grenoble

Patrick_35

Olivier_CEA_Grenoble

VDH-Bruno

Olivier_CEA_Grenoble

VDH-Bruno

VDH-Bruno

Olivier_CEA_Grenoble

Patrick_35

VDH-Bruno

VDH-Bruno

Olivier_CEA_Grenoble

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante