hi all,
I Need help to modify this lisp to Select a multiple objects for storing from Text to an OD.
any help appreciated.
;;
;; Routine (pour MAP/CIVIL) : Text_Sel2OD par CADaSchtroumpf pour Patrice B.
;;
;;
;; Affecter le contenu d un Texte : TEXT , MTEXT , ATTRIB , DIMENSION , etc
;; dans une OD de Type STRING
;; ou par conversion numerique dans une OD de type INTEGER ou REAL
;;
;; ListBox (Gilles Chanteau)
;; 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 sel_onlyText (msg / js)
(princ msg)
(while
(not
(setq js
(ssget "_+.:E:S:N"
(list
(cons 0 "*TEXT,MULTILEADER,ATTRIB,INSERT,DIMENSION")
(cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
(cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
)
)
)
)
)
(vlax-ename->vla-object (cadar (ssnamex js 0)))
)
(defun C:Text_Sel2OD ( / AcDoc Space loop loop_while l_tab tab_target list_field_target l_field field_target typ_target e_name string js_target ent)
(setq
AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space
(if (eq (getvar "CVPORT") 1)
(vla-get-PaperSpace AcDoc)
(vla-get-ModelSpace AcDoc)
)
loop T
loop_while T
)
(setq l_tab (ade_odtablelist))
(cond
((setq tab_target (listbox "TABLES" "Select the Target OD Table " (mapcar 'cons l_tab l_tab) 1))
(setq
list_field_target (ade_odtabledefn tab_target)
l_field (mapcar 'cdr (mapcar 'car (cdaddr list_field_target)))
)
(cond
((setq field_target (listbox "CHAMPS" (strcat "Select the Target OD Field for The Table " tab_target) (mapcar 'cons l_field l_field) 1))
(setq typ_target (cdr (assoc "ColType" (assoc (cons "ColName" field_target) (cdaddr list_field_target)))))
(alert (strcat "The type data will be " typ_target))
(while (and loop (setq e_name (sel_onlyText "\nSelect the Source Text : ")))
(setq string
(cond
((vlax-property-available-p e_name 'TextString) (vlax-get e_name 'TextString))
((vlax-property-available-p e_name 'Measurement)
(if (eq (vlax-get e_name 'TextOverride) "")
(rtos (vlax-get e_name 'Measurement) 2 8)
(vlax-get e_name 'TextOverride)
)
)
)
)
(cond
(string
(princ "\nSelect an object for storing the Text to an OD ")
(while
(null
(setq js_target
(ssget
(list
(cons 0 "*")
(cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
(cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
)
)
)
)
)
(setq ent (ssname js_target 0))
(cond
((member tab_target (ade_odgettables ent))
(ade_odsetfield ent tab_target field_target 0
(cond
((eq typ_target "Character") string)
((eq typ_target "Integer") (atoi string))
((eq typ_target "Real") (atof string))
)
)
(princ (strcat "\nThe Value " (cond ((eq typ_target "Character") string) ((eq typ_target "Integer") (itoa (atoi string))) (T (rtos (atof string)))) " is stored to the Field " field_target))
)
(T (princ (strcat "\nThe Table " tab_target " is not attached to the selected object ! ")))
)
)
)
(if loop_while
(progn (princ "\t<ESC to Quit>") (setq loop T))
(setq loop nil)
)
)
)
)
)
)
(prin1)
)
