Message posté par : bruno v.
----------------------------------------
-----------------
Patrice écrit :
Autre solution : une routine Lisp "directe" qui mettrait a jour un champ OD
reel/flottant nomme par exemple PROFONDEUR
depuis 2 autres champs OD reels/flottants nommes par exemple : Z_TERRAIN & Z_FILDEAU
!
LA SANTE, GeoBye, Pat ... En retraite depuis 6 jours ...
-----------------
C'est vrai que ça pourrait être une fonction intéressante à faire, je m'y colle.
Un embryon qui à l'air de fonctionner (après tests sommaires), c'est un premier
jus. Je me suis contenté des 4 opérateurs arithmétique basique, on pourrait aussi
envisager de concaténer des chaines de caractères...
-----------------
Code :
; str2lst
;; Transforme un chaine avec séparateur en liste de chaines
;;
;; Arguments
;; str : la chaine à transformer en liste
;; sep : le séparateur
;;
;; 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 déroulante
;; 1 = liste choix unique
;; 2 = liste choix multipes
;;
;; Retour : la clé de l'option (flag = 0 ou 1) ou la liste des clés des options (flag
= 2)
;;
;; Exemple d'utilisation
;; (listbox "Présentation" "Choisir une présentation" (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:operate_OD ( / sel_tbl def_tbl l_field sel1_field sel2_field op_field sel3_field
js n ent)
(setq sel_tbl (listbox "Donnée d'objet" "Choisir la table de données
d'objet" (mapcar 'cons (ade_odtablelist) (ade_odtablelist)) 1))
(cond
(sel_tbl
(setq
def_tbl (ade_odtabledefn sel_tbl)
l_field (mapcar 'cdr (mapcar '(lambda (x) (assoc "ColName" x))
(cdaddr def_tbl)))
sel1_field (listbox "Champ de donnée" "Choisir le 1er champ de
donnée" (mapcar 'cons l_field l_field) 1)
sel2_field (listbox "Champ de donnée" "Choisir le 2ème champ de
donnée" (mapcar 'cons l_field l_field) 1)
)
(cond
((and
sel1_field
sel2_field
(member (cdr (assoc "ColType" (assoc (cons "ColName" sel1_field)
(cdaddr def_tbl)))) '("Real" "Integer"))
)
(setq
op_field (listbox "Opérateur arithmétique" "Choisir
l'opérande" '(("+ " . "+ ") ("- " . "-
") ("* " . "* ") ("/ " . "/ ")) 1)
sel3_field (listbox "Champ de donnée RESULTAT" "Choisir le 3éme champ
de donnée à inscrire" (mapcar 'cons l_field l_field) 1)
)
(cond
((and
op_field
sel3_field
(member (cdr (assoc "ColType" (assoc (cons "ColName"
sel3_field) (cdaddr def_tbl)))) '("Real" "Integer"))
)
(setq js (ssget "_X"))
(cond
(js
(repeat (setq n (sslength js))
(if (member sel_tbl (ade_odgettables (setq ent (ssname js (setq n (1- n))))))
(ade_odsetfield ent sel_tbl sel3_field 0
(eval
(list
(read op_field)
(ade_odgetfield ent sel_tbl sel1_field 0)
(ade_odgetfield ent sel_tbl sel2_field 0)
)
)
)
)
)
)
)
)
(T (princ "\nLe champs résultat ne conviennent pas; doit être un réel ou
entier"))
)
)
(T (princ "\nLes champs sources ne conviennent pas; doivent être des réels ou
entiers"))
)
)
)
(prin1)
)
-----------------
----------------------------------------
Le message est situé
https://georezo.net/forum/viewtopic.php?pid=335919#p335919
Pour y répondre : autodesk_sig_fr(a)ml.georezo.net ou reply de votre messagerie
Pour vous désabonner connectez-vous sur le forum puis Profil / Abonnement
--
Association GeoRezo - le portail géomatique
https://georezo.net