Convert dump functions in List format

Luna · le 9 décembre 2021

Coucou,

Je me pose la question suivante : Est-il possible d'accéder à l'intégralité des propriétés d'un objet et de les récupérer sous forme de liste ?
A ce jour, je connais 3 "listes" de propriétés accessibles pour un objet :

(entget) permet d'afficher sous forme de liste l'ensemble des propriétés DXF d'un objet
(dumpallproperties) permet d'afficher dans l'historique de la fenêtre de texte (F2) l'ensemble des propriétés génériques d'un objet
(vlax-dump-object) permet d'afficher dans l'historique de la fenêtre de texte (F2) l'ensemble des propriétés Visual LISP d'un objet

Autrement dit, sur les 3 méthodes de récupération d'information, seule une renvoie une liste exploitable dans un programme LISP. Pour chacune de ces méthodes, il existe des fonctions pour récupérer la valeur d'une propriété et/ou la modifier :

(assoc) et (entmod) pour la fonction (entget)
(getpropertyvalue) et (setpropertyvalue) pour la fonction (dumpallproperties)
(vlax-get) et (vlax-put) et l'ensemble de leur écriture dérivée pour la fonction (vlax-dump-object)

Cependant il faut connaître le nom de la propriété pour en récupérer la valeur puisque seule la fonction (entget) retourne une liste exploitable par un programme.
Du coup j'ai regardé s'il existait un moyen de récupérer une liste pour les fonction (dumpallproperties) et (vlax-dump-object) et j'ai trouvé les fonctions suivantes sur le site de LeeMac : http://www.lee-mac.com/dumpobject.html. Cette fonction utilise la fonction (atoms-family) pour récupérer la totalité des fonctions/commandes AutoCAD enregistrée dans le dessin et utilise le principe de simplification d'écriture de la fonction (vlax-get) pour récupérer toutes les fonctions Visual dont le nom commence par "VLA-GET-". Cela permet ainsi d'obtenir habilement le nom de l'ensemble des propriétés existantes en Visual LISP, puis filtre les propriétés disponible pour l'objet sélectionné via (vlax-property-available-p). Cela permet ainsi d'obtenir le résultat de (vlax-dump-object) sous format d'une liste.

On arrive donc à avoir (entget) et (vlax-dump-object) sous forme de liste mais en revanche, la méthode employée par LeeMac ne fonctionne pas pour (dumpallproperties) puisqu'il n'y a pas ces dérivés d'écriture pour les fonctions associées. Pensez-vous qu'il soit possible d'obtenir le résultat de (dumpallproperties) sous forme de liste ou bien est-ce la fameuse exception à la règle ? Peut-on avoir accès à l'historique de la fenêtre de texte ou bien est-elle intouchable en programmation ?

Désolée si je n'ai pas été assez claire...

Bisous,
Luna

Olivier Eckmann · le 9 décembre 2021

Bonjour,

Lorsque j'ai besoin de récupérer ce qui passe en ligne de commande, j'active la variable LOGFILEMODE à 1, dès lors tout ce qui se passe est enregistré dans le fichier défini par LOGFILENAME. Et je repasse la variable LOGFILEMODE à 0 quand j'ai terminé ce que je dois récupérer, puis je vais lire le fichier .log

Olivier

Luna · le 9 décembre 2021

Intéressant, je ne connaissais pas cette variable système. Je vais étudier cela pour voir si c'est viable 🙂

Merci !

Bisous,
Luna

GEGEMATIC · le 9 décembre 2021

Salut,

comme olivier, ci dessous un exemple d'utilisation pour effacer des messages d'erreur:

;;**************************************************************************
;;§/DEBUG/supprimer les entités qui pose un problème *Avertissement*: objet en propriété multiple, maintien  / none
;;*Avertissement*: objet en propriété multiple, maintien "B6DA"
;;*Warning* Multiply owned object, handle 

(defun c:clearMultiplyOwnedObject (/ llign lign pos fname f wait  lerror lhandle ent tp)

  (setq fname (getvar "LOGFILENAME"))

  (pw_setvar1 "LOGFILEMODE" 0)
  (pw_setvar1 "CMDECHO" 0)
  (vl-file-delete fname)
  (setvar "LOGFILEMODE" 1)
  (command "_qsave")
  (while (= 1 (getvar "cmdactive"))
    wait
  )
  (command "_delay" 50)
  (getstring "\NclearMultiplyOwnedObject en cours d'exécution, entrée pour continuer")
  (setvar "LOGFILEMODE" 0)
  ;;(setvar "LOGFILEMODE" 1)
  (setq fname (getvar "LOGFILENAME"))
  ;;(prompt "\nFin de capture") 

;;;  (setq f (open fname "r"))
;;;  
;;;  (while (and (setq lign (read-line f))
;;;              (not (= lign "Fin de capture")))
;;;    wait
;;;  )
;;;  (close f)
;;;  
  (setq f (open fname "r"))

  (while (setq lign (read-line f))
    (setq llign (cons lign llign))
  )
  (close f)


  (pw_setvar2 "LOGFILEMODE")
  (pw_setvar2 "CMDECHO")
  (setq llign (reverse llign))
  (if (not
	(setq
	  lerror (pw_wcmatch_list llign "*objet en propriété multiple*")
	)
      )
    (setq lerror (pw_wcmatch_list llign "*Multiply owned object*"))
  )

  (if lerror
    (progn

      (setq lhandle (mapcar '(lambda (x /)
			       (setq x (pw_lst_de_ch x " "))
			       (setq x (last x))
			       (setq x (vl-string-trim "\"" x))

			     )
			    lerror
		    )
      )
    )
  )
  (setq lhandle (PW_REDUCT_LIST lhandle))
  (if lhandle
    (progn
      (setq lentity (mapcar 'strcase (mapcar 'car PW-L-ENT-CMD)))
      (foreach ent lhandle
	(setq tp (cdr (assoc 0 (entget (setq ent (handent ent))))))
	(if (not (member tp lentity))
	  (entdel ent)
	  (print tp)
	)
      )
    )
  )
)

a+

Gégé

Luna · le 10 décembre 2021

Coucou,

Du coup la méthode du LOGFILEMODE semble fonctionner correctement, en revanche j'ai un léger soucis. En effet le programme que j'ai écrit permet de récupérer les key et value renvoyés par (dumpallproperties) pour les mettre sous forme de liste de paires pointées. Mais certains objets possèdent des propriétés "Item #:" qui possèdent des sous-propriétés. Cela pose donc un peu problème étant donné qu'il faut du coup avoir des imbrications de listes de paires pointées pour ces entités. De plus le fichier journal possède toutes les value sous format 'STR (string), donc je me suis dit que pour récupérer les value, il serait préférable de passer par (getpropertyvalue) mais il me retourne forcément une erreur "Demande ADS erronée" lorsque j'essaye de récupérer ces données.

Je suis tombée sur le post de @(gile) à propos des "Vertices" d'une polyligne qui fonctionne justement avec ce système d'item. Mais je n'arrive pas à récupérer les valeurs donc je me demande si l'écriture

(getpropertyvalue pline "Vertices" 0 "IsA")

est la bonne ou pas...

Choix de l'objet: Begin dumping object (class: AcDbPolyline)
Annotative (type: bool)  (LocalName: Annotatif) = Failed to get value
AnnotativeScale (type: AcString)  (RO)  (LocalName: Echelle annotative) = Failed to get value
Area (type: double)  (RO)  (LocalName: Aire) = 604869.004505
BlockId (type: AcDbObjectId)  (RO) = 2a3d74c31f0
CastShadows (type: bool) = 0
ClassName (type: AcString)  (RO) =
Closed (type: bool)  (LocalName: Fermé) = 0
CollisionType (type: AcDb::CollisionType)  (RO) = 1
Color (type: AcCmColor)  (LocalName: Couleur) = DUCALQUE
ConstantWidth (type: double)  (LocalName: Largeur globale) = 0.000000
Elevation (type: double)  (LocalName: Elévation) = 0.000000
EndParam (type: double)  (RO) = 5.000000
EndPoint/X (type: double)  (RO)  (LocalName: Extrémité X) = Failed to get value
EndPoint/Y (type: double)  (RO)  (LocalName: Extrémité Y) = Failed to get value
EndPoint/Z (type: double)  (RO)  (LocalName: Extrémité Z) = Failed to get value
ExtensionDictionary (type: AcDbObjectId)  (RO) = 0
Handle (type: AcDbHandle)  (RO) = 5ef
HasBulges (type: bool)  (RO) = 0
HasFields (type: bool)  (RO) = 0
HasSaveVersionOverride (type: bool) = 0
HasWidth (type: bool)  (RO) = 0
Hyperlinks (type: AcDbHyperlink*)
IsA (type: AcRxClass*)  (RO) = AcDbPolyline
IsAProxy (type: bool)  (RO) = 0
IsCancelling (type: bool)  (RO) = 0
IsEraseStatusToggled (type: bool)  (RO) = 0
IsErased (type: bool)  (RO) = 0
IsModified (type: bool)  (RO) = 0
IsModifiedGraphics (type: bool)  (RO) = 0
IsModifiedXData (type: bool)  (RO) = 0
IsNewObject (type: bool)  (RO) = 0
IsNotifyEnabled (type: bool)  (RO) = 0
IsNotifying (type: bool)  (RO) = 0
IsObjectIdsInFlux (type: bool)  (RO) = 0
IsOnlyLines (type: bool)  (RO) = 1
IsPeriodic (type: bool)  (RO) = 0
IsPersistent (type: bool)  (RO) = 1
IsPlanar (type: bool)  (RO) = 1
IsReadEnabled (type: bool)  (RO) = 1
IsReallyClosing (type: bool)  (RO) = 1
IsTransactionResident (type: bool)  (RO) = 0
IsUndoing (type: bool)  (RO) = 0
IsWriteEnabled (type: bool)  (RO) = 0
LayerId (type: AcDbObjectId)  (LocalName: Calque) = 2a3d74c3100
Length (type: double)  (RO)  (LocalName: Longueur) = 3141.549965
LineWeight (type: AcDb::LineWeight)  (LocalName: Epaisseur de ligne) = -1
LinetypeId (type: AcDbObjectId)  (LocalName: Type de ligne) = 2a3d74c3150
LinetypeScale (type: double)  (LocalName: Echelle du type de ligne) = 1.000000
LocalizedName (type: AcString)  (RO) = Polyligne
MaterialId (type: AcDbObjectId)  (LocalName: Matériau) = 2a3d74c36c0
MergeStyle (type: AcDb::DuplicateRecordCloning)  (RO) = 1
Normal/X (type: double) = 0.000000
Normal/Y (type: double) = 0.000000
Normal/Z (type: double) = 1.000000
ObjectId (type: AcDbObjectId)  (RO) = 2a426666ef0
OwnerId (type: AcDbObjectId)  (RO) = 2a3d74c31f0
Plinegen (type: bool)  (LocalName: Génération du type de ligne) = 0
PlotStyleName (type: AcString)  (RO)  (LocalName: Style de tracé) = ParCouleur
ReceiveShadows (type: bool) = 0
ShadowDisplay (type: AcDb::ShadowFlags)  (RO)  (LocalName: Affichage des ombres) = Failed to get value
StartParam (type: double)  (RO) = 0.000000
StartPoint/X (type: double)  (RO)  (LocalName: Départ X) = Failed to get value
StartPoint/Y (type: double)  (RO)  (LocalName: Départ Y) = Failed to get value
StartPoint/Z (type: double)  (RO)  (LocalName: Départ Z) = Failed to get value
Thickness (type: double)  (LocalName: Epaisseur) = 0.000000
Transparency (type: AcCmTransparency)  (LocalName: Transparence) = 0
Vertices (type: AcDbPolylineVertex)
Item 0:
    Bulge (type: double) = Failed to get value
    ClassName (type: AcString)  (RO) =
    EndWidth (type: double)  (LocalName: Largeur du segment de fin) = Failed to get value
    Id (type: int) = Failed to get value
    IsA (type: AcRxClass*)  (RO) = AcRxBoxedValueOnStack
    LocalizedName (type: AcString)  (RO) =
    Position/X (type: double)  (LocalName: Sommet X) = Failed to get value
    Position/Y (type: double)  (LocalName: Sommet Y) = Failed to get value
    StartWidth (type: double)  (LocalName: Largeur du segment de départ) = Failed to get value
Item 1:
    Bulge (type: double) = Failed to get value
    ClassName (type: AcString)  (RO) =
    EndWidth (type: double)  (LocalName: Largeur du segment de fin) = Failed to get value
    Id (type: int) = Failed to get value
    IsA (type: AcRxClass*)  (RO) = AcRxBoxedValueOnStack
    LocalizedName (type: AcString)  (RO) =
    Position/X (type: double)  (LocalName: Sommet X) = Failed to get value
    Position/Y (type: double)  (LocalName: Sommet Y) = Failed to get value
    StartWidth (type: double)  (LocalName: Largeur du segment de départ) = Failed to get value
Item 2:
    Bulge (type: double) = Failed to get value
    ClassName (type: AcString)  (RO) =
    EndWidth (type: double)  (LocalName: Largeur du segment de fin) = Failed to get value
    Id (type: int) = Failed to get value
    IsA (type: AcRxClass*)  (RO) = AcRxBoxedValueOnStack
    LocalizedName (type: AcString)  (RO) =
    Position/X (type: double)  (LocalName: Sommet X) = Failed to get value
    Position/Y (type: double)  (LocalName: Sommet Y) = Failed to get value
    StartWidth (type: double)  (LocalName: Largeur du segment de départ) = Failed to get value
Item 3:
    Bulge (type: double) = Failed to get value
    ClassName (type: AcString)  (RO) =
    EndWidth (type: double)  (LocalName: Largeur du segment de fin) = Failed to get value
    Id (type: int) = Failed to get value
    IsA (type: AcRxClass*)  (RO) = AcRxBoxedValueOnStack
    LocalizedName (type: AcString)  (RO) =
    Position/X (type: double)  (LocalName: Sommet X) = Failed to get value
    Position/Y (type: double)  (LocalName: Sommet Y) = Failed to get value
    StartWidth (type: double)  (LocalName: Largeur du segment de départ) = Failed to get value
Item 4:
    Bulge (type: double) = Failed to get value
    ClassName (type: AcString)  (RO) =
    EndWidth (type: double)  (LocalName: Largeur du segment de fin) = Failed to get value
    Id (type: int) = Failed to get value
    IsA (type: AcRxClass*)  (RO) = AcRxBoxedValueOnStack
    LocalizedName (type: AcString)  (RO) =
    Position/X (type: double)  (LocalName: Sommet X) = Failed to get value
    Position/Y (type: double)  (LocalName: Sommet Y) = Failed to get value
    StartWidth (type: double)  (LocalName: Largeur du segment de départ) = Failed to get value
Item 5:
    Bulge (type: double) = Failed to get value
    ClassName (type: AcString)  (RO) =
    EndWidth (type: double)  (LocalName: Largeur du segment de fin) = Failed to get value
    Id (type: int) = Failed to get value
    IsA (type: AcRxClass*)  (RO) = AcRxBoxedValueOnStack
    LocalizedName (type: AcString)  (RO) =
    Position/X (type: double)  (LocalName: Sommet X) = Failed to get value
    Position/Y (type: double)  (LocalName: Sommet Y) = Failed to get value
    StartWidth (type: double)  (LocalName: Largeur du segment de départ) = Failed to get value
Visible (type: AcDb::Visibility) = 0
End object dump

Sinon tant pis et je repasse en version 'STR pour les value.

Bisous,
Luna

Luna · le 10 décembre 2021

Bon j'ai fini par trouver une solution (cependant la liste correspondant aux Item n'est pas une liste d'association, ce qui m'embête quelque peu donc j'essaierai de trouver une solution...). Je n'ai pas vraiment testé si cela fonctionne de manière universelle et je suis persuadée que l'on peut simplifier l'écriture mais bon, ci-dessous mon code :

(defun dumpallproperties->list (name / *error* get-key&value filename lmf cme file c n k-p line lst sub tmp i dap)

	(defun *error* (msg)

		(if file
			(setq file (close file))
		)
		(if lmf
			(setvar "LOGFILEMODE" lmf)
			(setvar "LOGFILEMODE" 0)
		)
		(if cme
			(setvar "CMDECHO" cme)
			(setvar "CMDECHO" 1)
		)
		(princ msg)

	)

	(defun get-key&value (l s p name a / key value)

		(cons
			(setq key (substr l s (- (vl-string-search p l) s)))
			(if (not (or (vl-catch-all-error-p (setq value (vl-catch-all-apply 'getpropertyvalue (append (list name) a (list key)))))
				     (null value)
			    ))
				value
				(if (or (not (wcmatch l "* = *"))
					(= (setq value (substr l (+ 1 (strlen " = ") (vl-string-search " = " l))))
					   "Failed to get value"
					)
				    )
					""
					value
				)
			)
		)

	)

	(setq filename (getvar "LOGFILENAME")
	      lmf (getvar "LOGFILEMODE")
	      cme (getvar "CMDECHO")
	)
	(vl-file-delete filename)
	(setvar "CMDECHO" 0)
	(setvar "LOGFILEMODE" 1)
	(dumpallproperties name)
	(setvar "LOGFILEMODE" 0)
	(setvar "CMDECHO" 1)
	(setq filename (getvar "LOGFILENAME")
	      file (open filename "R")
	      c 1
	      n 5
	      k-p "(type:"
	)
	(while (setq line (read-line file))
		(setq lst (cons line lst))
	)
	(close file)
	(setq lst
		(vl-remove-if  '(lambda (l) (= l ""))
				(reverse lst)
		)
	)
	(while	(and lst
		     (not (wcmatch (car lst) "*Begin dumping object*"))
		)
		(setq lst (cdr lst))
	)
	(setq lst (reverse (cdr lst)))
	(while	(and lst
		     (not (wcmatch (car lst) "End object dump"))
		)
		(setq lst (cdr lst))
	)
	(setq lst (reverse (cdr lst)))
	(while (and lst (setq l (car lst)))
		(setq dap
			(cons
				(cond
					( (and (not (wcmatch l "* = *"))
					       (wcmatch (cadr lst) "Item #*:")
					  )
						(cons
							(setq sub nil l (substr l c (- (vl-string-search k-p l) c)))
							(while (wcmatch (cadr lst) "Item #*:")
								(setq sub
									(append sub
										(list
											(setq tmp nil i (atoi (vl-string-trim (apply 'strcat (wildcard-trim "~#")) (car (setq lst (cdr lst))))))
											(while (wcmatch (cadr lst) "   ?*")
												(setq tmp
													(append tmp
														(list (get-key&value (car (setq lst (cdr lst))) n k-p name (list l i)))
													)
												)
											)
										)
									)
								)
							)
						)
					)
					(T
						(get-key&value l c k-p name nil)
					)
				)
				dap
			)
		      lst (cdr lst)
		)
	)
	(reverse dap)

)

(defun wildcard-trim (w / i lst a)

	(repeat (setq i 256)
		(if (wcmatch (setq a (chr (setq i (1- i)))) w)
			(setq lst (cons a lst))
		)
	)
	lst

)

Si des âmes charitables souhaitent tester, je ne suis pas contre ! ♥w♥

Bisous,
Luna

Modifié le 10 décembre 2021 par Luna
C'est mieux avec la fonction (wildcard-trim) sinon chat marche pas...

OlivierR · le 24 janvier

Salut Luna,

Je n'ai pas testé dans beaucoup de cas mais cela fonctionne parfaitement pour mon cas (trouver l'échelle d'annotation d'une fenêtre).

Si tu le permets je garde précieusement ta fonction au chaud.

Et merci Olivier pour ton aide.

Olivier

Connexion

Convert dump functions in List format

Messages recommandés

Luna

Olivier Eckmann

Luna

GEGEMATIC

Luna

Luna

OlivierR

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante