Routine de Préfixe - Suffixe - Nouvelle valeur pour Données D'Objets

fabcad · le 3 mai 2022

Bonjour à vous,

J'ai créé une routine "amelioree" pour gérer des valeurs de Données D'Objets (Chaines de caractères) à la demande de LeCrabe.

Elle fonctionne mais je souhaiterais que le fichier DCL soit dans le Lisp pour avoir qu'un seul fichier à charger.

Merci pour l'aide aux talentueu(ses)x programmeurs.

Fabcad - Le Rennais Métropolitain

gestionnaire_od.dcl gestionnaire_od.lsp

lecrabe · le 3 mai 2022

Hello Fab

1) OUI ta routine est bien plus joile que la "mienne" (tres frustre) et avec un DCL "integree" , elle sera Tip-Top !

2) D'ailleurs notre Maitre AutoCAD MAP (Bonuscad- Bruno) a fait aussi sa propre version ...

MERCI Bruno & Fab & Gilles & VDH-Bruno & Luna & autres Pros du Lisp / VLisp ...

La Sante, Bye, lecrabe


(vl-load-com) 

; str2lst
;; Transforme un chaine avec separateur en liste de chaines
;;
;; Arguments
;; str : la chaine a transformer en liste
;; sep : le separateur
;;
;; Exemples
;; (str2lst "a b c" " ") -> ("a" "b" "c")
;; (str2lst "1,2,3" ",") -> ("1" "2" "3")
(defun str2lst (str sep / pos)
	(if (setq pos (vl-string-search sep str))
		(cons
			(substr str 1 pos)
			(str2lst (substr str (+ (strlen sep) pos 1)) sep)
		)
		(list str)
	)
) 

;; ListBox (gile)
;; Boite de dialogue permettant un ou plusieurs choix dans une liste
;;
;; Arguments
;; title : le titre de la boite de dialogue (chaîne)
;; msg ; message (chaîne), "" ou nil pour aucun
;; keylab : une liste d'association du type ((key1 . label1) (key2 . label2) ...)
;; flag : 0 = liste deroulante
;; 1 = liste choix unique
;; 2 = liste choix multipes
;;
;; Retour : la cle de l'option (flag = 0 ou 1) ou la liste des cles des options (flag = 2)
;;
;; Exemple d'utilisation
;; (listbox "Presentation" "Choisir une presentation" (mapcar 'cons (layoutlist) (layoutlist)) 1)
(defun ListBox (title msg keylab flag / tmp file dcl_id choice)
	(setq
		tmp (vl-filename-mktemp "tmp.dcl")
		file (open tmp "w")
	)
	(write-line
		(strcat "ListBox:dialog{label=\"" title "\";")
		file
	)
	(if (and msg (/= msg ""))
		(write-line (strcat ":text{label=\"" msg "\";}") file)
	)
	(write-line
		(cond
			((= 0 flag) "spacer;:popup_list{key=\"lst\";")
			((= 1 flag) "spacer;:list_box{key=\"lst\";")
			(T "spacer;:list_box{key=\"lst\";multiple_select=true;")
		)
		file
	)
	(write-line "}spacer;ok_cancel;}" file)
	(close file)
	(setq dcl_id (load_dialog tmp))
	(if (not (new_dialog "ListBox" dcl_id))
		(exit)
	)
	(start_list "lst")
	(mapcar 'add_list (mapcar 'cdr keylab))
	(end_list)
	(action_tile
		"accept"
		"(or (= (get_tile \"lst\") \"\")
			(if (= 2 flag)
				(progn
					(foreach n (str2lst (get_tile \"lst\") \" \")
						(setq choice (cons (nth (atoi n) (mapcar 'car keylab)) choice))
					)
					(setq choice (reverse choice))
				)
				(setq choice (nth (atoi (get_tile \"lst\")) (mapcar 'car keylab)))
			)
		)
		(done_dialog)"
	)
	(start_dialog)
	(unload_dialog dcl_id)
	(vl-file-delete tmp)
	choice
)


(defun C:OD_Pref_Suff_Text ( / Table_OD def_tbl l_field Champ_OD Pref1 Suff1 js n_pl)
	(setq Table_OD (listbox "Donnee d'objet" "Choisir la table de donnees d'objet" (mapcar 'cons (ade_odtablelist) (ade_odtablelist)) 1))
	(cond
		(Table_OD
			(setq
				def_tbl (ade_odtabledefn Table_OD)
				l_field (mapcar 'cdr (mapcar '(lambda (x) (assoc "ColName" x)) (cdaddr def_tbl)))
				champ_OD (listbox "Champ de donnee" "Choisir le 1er champ de donnee" (mapcar 'cons l_field l_field) 1)
			)
			(cond
				((eq (cdr (assoc "ColType" (assoc (cons "ColName" champ_OD) (cdaddr def_tbl)))) "Character")
					(setq
						Pref1 (getstring T "\nTexte du Prefixe : ")
						Suff1 (getstring T "\nTexte du Suffixe : ")
						js (ssget "_:L")
					)
					(cond
						((and js Pref1 Suff1)
							(repeat (setq n_pl (sslength js))
								(if (member Table_OD (ade_odgettables (setq ent (ssname js (setq n_pl (1- n_pl))))))
									(ade_odsetfield ent Table_OD Champ_OD 0 (strcat Pref1 " " (ade_odgetfield ent Table_OD Champ_OD 0) " " Suff1))
								)
							)
						)
					)
				)
				(T (princ "\nNe peut ajouter un prefixe ou suffixe a un champ autre que de type caractere ! "))
			)
		)
	)
(prin1)
)

Luna · le 3 mai 2022

Coucou,

Je ne peux pas tester malheureusement car je n'ai pas la fonction (ade_odtablelist) mais il me semble qu'il suffit de faire cela :

  ;Fichier gestionnaire_od.lsp
  ;;;---------------------------------------------------------------
  ;;;
  ;;; Lister les champs d'une table
  ;;;
  ;;;---------------------------------------------------------------
    (defun lister_fields (nom_tbl / fieldnames)
      (foreach x (cdr (assoc "Columns" (ade_odtabledefn nom_tbl)))
        (if (not (member (cdr (assoc "ColName" x)) fieldnames))
          (setq fieldnames (cons (cdr (assoc "ColName" x)) fieldnames))
        )
      )
    (if fieldnames (setq fieldnames (acad_strlsort fieldnames)))
    );fin defun

  ;;;---------------------------------------------------------------
  ;;;
  ;;; Afficher la liste des champs d'une table OD
  ;;;
  ;;;---------------------------------------------------------------

  (defun affiche (/ val)
    (if (setq liste_fields (lister_fields (nth (atoi pos_tbl) liste_tbl)))
      (progn
        (foreach val (list "txtat" "liste_fields" "txtva" "valeur" "accept" "nou" "pre" "suf" "wri")
          (mode_tile val 0)
        )
        (start_list "liste_fields")
          (mapcar '(lambda (x) (add_list x)) liste_fields)
        (end_list)
        ;(affiche_va)
      )
      (foreach val (list "liste_fields" "txtva" "valeur" "accept" "nou" "pre" "suf" "wri")
        (mode_tile val 1)
      )
    )
  )

  ;;;---------------------------------------------------------------
  ;;;
  ;;; Afficher la liste des champs d'une table OD
  ;;;
  ;;;---------------------------------------------------------------

(defun writeDCL ()
  (setq
    filename (vl-filename-mktemp "tmp.dcl")
    file (open filename "W")
  )
  (write-line
    (strcat
      "gestionnaire_od : dialog {"
      "  key = \"titre\";"
      "  is_cancel = true;"
      "  allow_accept = true;"
      "  : boxed_column {"
      "    label = \"Sélection de la table\";"
      "    key = \"txt_tbl\";"
      "    : row {"
      "      : popup_list {key = \"liste_tbl\"; width = 40;}"
      "    }"
      "    spacer;"
      "  }"
      "  : boxed_column {"
      "    label = \"Sélection du champ\";"
      "    key = \"txt_field\";"
      "    : row {"
      "      : popup_list {key = \"liste_fields\"; width = 40;}"
      "    }"
      "    spacer;"
      "  }"
      "  : boxed_column {"
      "    label = \"Valeur à propager\";"
      "    key = txtva;"
      "    : edit_box {key = \"valeur\";}"
      "    spacer;"
      "  }"
      "  spacer;"
      "  : row {"
      "    :radio_button {label = \"Nouvelle valeur\"; key = nou;}"
      "    :radio_button {label = \"Préfixe\"; key = pre;}"
      "    :radio_button {label = \"Suffixe\"; key = suf;}"
      "  }"
      "  spacer;"
      "  ok_cancel;"
      "}"
    )
    file
  )
  (setq file (close file))
)

  ;;;---------------------------------------------------------------
  ;;;
  ;;; Routine principale
  ;;;
  ;;;---------------------------------------------------------------
  (defun c:gestionnaire_od (/ *error* filename file liste_tbl Fic resultat table_choisie champ_choisi val_field pos_tbl pos_field choix selection msg_entrees)
  (defun *error* (msg)
    (if file (close file))
    (if filename (vl-file-delete filename))
    (princ msg)
  )
  (setvar "cmdecho" 0)
  (vl-load-com)
  (setq viewsize (getvar "VIEWSIZE"))
  (or *acad* (setq *acad* (vlax-get-acad-object)))
  (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument *acad*)))
  ;;; Création de la liste des tables OD existantes dans le dwg
  (setq liste_tbl (ade_odtablelist))
    ;;; choix "nou"
    (writeDCL)
    (setq Fic (load_dialog filename) val_field "------" pos_tbl "0" pos_field "0" )
    (if (not (new_dialog "gestionnaire_od" Fic)) (exit))

      (set_tile "titre" "gestionnaire_od V1.00")
      ;(set_tile choix "1")
      (affiche)
      (start_list "liste_tbl")
        (mapcar 'add_list liste_tbl)
      (end_list)

      (action_tile "liste_tbl"    "(setq table_choisie (nth (atoi $value) liste_tbl)) (setq pos_tbl $value) (affiche)")
      (action_tile "liste_fields" "(setq champ_choisi (nth (atoi $value) liste_fields)) (setq pos_field $value)")
      (action_tile "accept"       "(done_dialog 1)")
      (action_tile "cancel"       "(done_dialog 0)")
      (action_tile "valeur"       "(setq val_ch $value)")
      (action_tile "nou"          "(setq choix \"nou\")")
      (action_tile "pre"          "(setq choix \"pre\")")
      (action_tile "suf"          "(setq choix \"suf\")")
    (setq resultat (start_dialog))
    (unload_dialog Fic)
    (setq filename (vl-file-delete filename))
  (cond
    ((eq resultat 1)
      (setq msg_entrees
        (strcat
          "Nom de Table OD : " table_choisie "\n"
          "Nom du Champ : " champ_choisi "\n"
          "Valeur entrée : " val_ch "\n"
          "Option choisie : " choix
        );fin strcat
      )
      (alert msg_entrees)
      (setq selection (ssget))
        (setq space
          (if (= 1 (getvar 'cvport))
            (vla-get-PaperSpace *acdoc*)
            (vla-get-ModelSpace *acdoc*)
          )
        )
      (setq nbr (sslength selection))
      (setq i 0)
      (while (<= i (- nbr 1))
        (setq obj_acad (ssname selection i))
        (setq obj_vl (vlax-ename->vla-object obj_acad))
        (cond
          ((eq choix "nou")
            (if (and (/= (ade_odgettables obj_acad) nil) (/= (member table_choisie (ade_odgettables obj_acad)) nil));fin and
              (progn
                (setq recnum 0)
                (ade_odsetfield obj_acad table_choisie champ_choisi recnum val_ch)
                ; Changement de couleur (rouge) de l'objet en cours
                (vla-put-Color obj_vl 1)
              );fin progn
            );fin if
          ); fin si choix est égal à nouvelle valeur
          ((eq choix "pre")
            (if (and (/= (ade_odgettables obj_acad) nil) (/= (member table_choisie (ade_odgettables obj_acad)) nil));fin and
              (progn
                (setq recnum 0)
                (setq val_existante (ade_odgetfield obj_acad table_choisie champ_choisi recnum))
                (princ val_existante)
                (setq val_new (strcat val_ch " " val_existante))
                (princ val_new)
                (ade_odsetfield obj_acad table_choisie champ_choisi recnum val_new)
                ; Changement de couleur (rouge) de l'objet en cours
                (vla-put-Color obj_vl acRed)
              );fin progn
            );fin if
          ); fin si choix est égal à préfixe
          ((eq choix "suf")
            (if (and (/= (ade_odgettables obj_acad) nil) (/= (member table_choisie (ade_odgettables obj_acad)) nil));fin and
              (progn
                (setq recnum 0)
                (setq val_existante (ade_odgetfield obj_acad table_choisie champ_choisi recnum))
                (princ val_existante)
                (setq val_new (strcat val_existante " " val_ch))
                (princ val_new)
                (ade_odsetfield obj_acad table_choisie champ_choisi recnum val_new)
                ; Changement de couleur (rouge) de l'objet en cours
                (vla-put-Color obj_vl acRed)
              );fin progn
            );fin if
          ); fin si choix est égal à suffixe
        );fin cond des choix
        (vlax-release-object obj_vl)
        (setq i (+ i 1))
      ); Fin while
    ); fin eq resultat à 1
  );fin cond
  (princ)
  );fin defun c:gestionnaire_od

En gros, il te faut utiliser la fonction (vl-file-mktemp) pour créer un fichier dans le dossier %TEMP%, puis copier le contenu de ton fichier DCL dans un (write-line (strcat ...)) et en faisant attention que les guillemets " deviennent des \" et le tour est joué 😉
Toujours penser à (close) et (vl-file-delete) une fois le fichier écrit puis le programme terminé, et surtout je défini toujours une fonction (*error*) en local pour fermer le fichier temporaire s'il ne l'est pas déjà et supprimer le fichier temporaire s'il ne l'est pas déjà ! Sinon cela peut poser des problèmes car lors des phases de test, l'écriture ou l'ouverture de la boîte de dialogue posera toujours une erreur qui peut être très énervante par la suite si cette (*error*) n'est pas définie au plus tôt 😛

Bisous,
Luna

fabcad · le 3 mai 2022

Merci Luna,

Elle fonctionne 🙂

J'ai juste un souci dans la gestion du dialogue, il faut que je sélectionne dans chaque zone de liste pour que cela fonctionne.

Les valeurs proposées ne sont pas récupérées.

Bisous, Fabcad, Le Rennais Métropolitain

Luna · le 3 mai 2022

Coucou,

Vui c'est à cause de ceci :

      (action_tile "liste_tbl"    "(setq table_choisie (nth (atoi $value) liste_tbl)) (setq pos_tbl $value) (affiche)")
      (action_tile "liste_fields" "(setq champ_choisi (nth (atoi $value) liste_fields)) (setq pos_field $value)")
      (action_tile "accept"       "(done_dialog 1)")
      (action_tile "cancel"       "(done_dialog 0)")
      (action_tile "valeur"       "(setq val_ch $value)")
      (action_tile "nou"          "(setq choix \"nou\")")
      (action_tile "pre"          "(setq choix \"pre\")")
      (action_tile "suf"          "(setq choix \"suf\")")

Habituellement, on préfère mettre la définition des variables sur le bouton "accept", permettant ainsi de différencier le bouton "accept" du bouton "cancel". Et on utilise également les {radio_row} ou {radio_column} pour grouper les {radio_button} ensemble.

Bisous,
Luna

fabcad · le 4 mai 2022

Merci Luna pour ta réponse,

Définition des variables sur le bouton "accept", là je suis largué, je ne maitrise pas le dcl.

Bisous, Fabcad, Le Rennais Métropolitain

Luna · le 4 mai 2022

En clair, si on veut s'assurer que les valeurs de chaque Tile soit bien récupérées à la fermeture de la boîte de dialogue via le bouton "accept", il faut définir tes variables (choix, val_ch, table_choisie, champ_choisi, ...) dans la fonction (action_tile) de ton bouton "accept" et non les définir via un (action_tile) pour chaque bouton...

Donc je remplacerais

      (action_tile "liste_tbl"    "(setq table_choisie (nth (atoi $value) liste_tbl)) (setq pos_tbl $value) (affiche)")
      (action_tile "liste_fields" "(setq champ_choisi (nth (atoi $value) liste_fields)) (setq pos_field $value)")
      (action_tile "accept"       "(done_dialog 1)")
      (action_tile "cancel"       "(done_dialog 0)")
      (action_tile "valeur"       "(setq val_ch $value)")
      (action_tile "nou"          "(setq choix \"nou\")")
      (action_tile "pre"          "(setq choix \"pre\")")
      (action_tile "suf"          "(setq choix \"suf\")")

par

      (action_tile "liste_tbl" "(affiche $value)")
      (action_tile "accept"    "(accept_tile) (done_dialog)")
      (action_tile "cancel"    "(done_dialog)")

et j'ajouterais du coup la fonction (accept_tile) dans les fonctions localement déclarées comme ceci :

(defun accept_tile ()
  (setq
    pos_tbl (get_tile "liste_tbl")
    table_choisie (nth (atoi pos_tbl) liste_tbl)
    pos_field (get_tile "liste_fields")
    champ_choisi (nth (atoi pos_field) liste_fields)
    val_ch (get_tile "valeur")
    choix
      (cond
        ((= "1" (get_tile "nou")) "nou")
        ((= "1" (get_tile "pre")) "pre")
        ((= "1" (get_tile "suf")) "suf")
      )
  )
)

Sans oublier du coup de modifier ta fonction (affiche) comme ceci (car 'pos_tbl' ne sera défini qu'à la fin de la boîte de dialogue) :

  (defun affiche (v / val)
    (if (setq liste_fields (lister_fields (nth (atoi v) liste_tbl)))
      (progn
        (foreach val (list "txtat" "liste_fields" "txtva" "valeur" "accept" "nou" "pre" "suf" "wri")
          (mode_tile val 0)
        )
        (start_list "liste_fields")
          (mapcar '(lambda (x) (add_list x)) liste_fields)
        (end_list)
        ;(affiche_va)
      )
      (foreach val (list "liste_fields" "txtva" "valeur" "accept" "nou" "pre" "suf" "wri")
        (mode_tile val 1)
      )
    )
  )

En théorie, en fonctionnant comme ceci, toutes les variables seront définie à partir du moment où la boîte de dialogue est close, sans devoir activer les (action_tile) de tous tes boutons pour les définir... Ainsi, même si tu ouvres la boîte de dialogue puis la referme aussitôt via le bouton "accept", tes variables seront tout de même définie (d'où l'importance des valeurs par défaut 😜) !

Je n'ai pas vraiment testé (car il se fait tard ^^"), peut-être ai-je mal interprété les retours de (get_tile) donc n'hésite pas à me dire si quelque chose cloche

Bisous,
Luna

PHILPHIL · le 8 novembre 2022

hello

je suis tomber par hazard ici.

je suis sous autocad architecture, ( j'ai autocad MEP non installé )

Le 03/05/2022 à 14:32, Luna a dit :

Coucou,

Je ne peux pas tester malheureusement car je n'ai pas la fonction (ade_odtablelist) mais il me semble qu'il suffit de faire cela :

cette fonction "ADE_ODTABLELIST" sert elle a faire la liste des "données étendues" des entités ?

si oui qu'elle est la fonction équivalente sous autocad architecture ? s'il y en a une bien sur.

ou récupérer le *.dll / *.arx de Mep comportant cette fonction et le faire fonctionner sous autocad architecture ?

sinon j'essaie de tester ca, ( si ca a quelque chose a voir car la je n'en sais rien )

(defun c:recuper_donnee_etendue ()
 (setq vlaobj          (vlax-ename->vla-object (car (entsel "Select a block: ")))
      acadobj         (vlax-get-acad-object)
      schedapp        (vla-getinterfaceobject acadobj "AecX.AecScheduleApplication")
;;;      schedapp        (vla-getinterfaceobject acadobj "AecPropDataMgd")
      propsets        (vlax-invoke-method schedapp 'propertysets vlaobj)
      psdname         "RoomObjects"
      propset         (vlax-invoke-method propsets 'item psdname)
      properties      (vlax-get-property propset 'properties)
      propnamevallist (reverse
                        (vlax-for prop properties
                          (setq propnamevallist (cons (cons (vlax-get-property prop 'name) (vlax-variant-value (vlax-get-property prop 'value)))
                                                      propnamevallist
                                                )
                          )
                        )
                      )
)
)

mais impossible de mettre la mains sur "AecX.AecScheduleApplication"

il a été remplacé par un autre *.arx ou *.dll ??

a+

Phil

fabcad · le 9 novembre 2022

Bonjour,

La fonction lisp d'AutoCAD MAP "ADE_ODTABLELIST" sert à répertorier les tables de Données d'Objets d'un projet AutoCAD MAP.

Les Données d'Objets ne sont lisibles que sur AutoCAD MAP (ou AutoCAD CIVIL) et ne sont pas des Données Étendues (XDATAS).

Fabcad
Le Rennais Métropolitain

PHILPHIL · le 9 novembre 2022

hello

petite question de sémantique alors.

et comment les récupérer ?

quel est le nom des "données" sous "ligne" sous "jeux de propriétés"

l'onglet s'appelle bien "donnée étendues"

image.png.0150898d9899bd990b6c29673b54c88c.png

Phil

Connexion

Routine de Préfixe - Suffixe - Nouvelle valeur pour Données D'Objets

Messages recommandés

fabcad

lecrabe

Luna

fabcad

Luna

fabcad

Luna

PHILPHIL

fabcad

PHILPHIL

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante