Hi,
With this, you can select many object at one once and select multiple ObjectData (use ctrl + pick in dialog box)
I hope respond to your ask!
(vl-load-com)
(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)
)
)
(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 "}ok_cancel_err;}" 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:OD2Label_Side ( / js ename htx AcDoc Space nw_style lst_tabl_def inc_key lst_def desc_od desc_tbl str msg pt deriv rtx nw_obj)
(setq lst_def nil)
(princ "\nSélectionnez une polyligne.")
(while
(null
(setq js
(ssget
(list
'(0 . "*POLYLINE,LINE,ARC,CIRCLE,ELLIPSE,SPLINE")
(cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
(cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
)
)
)
)
(princ "\nCe n'est pas un objet valable pour cette fonction!")
)
(setq
AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space
(if (= 1 (getvar "CVPORT"))
(vla-get-PaperSpace AcDoc)
(vla-get-ModelSpace AcDoc)
)
)
(cond
((null (tblsearch "LAYER" "Label"))
(vlax-put (vla-add (vla-get-layers AcDoc) "Label") 'color 96)
)
)
(cond
((null (tblsearch "STYLE" "Arial-Label"))
(setq nw_style (vla-add (vla-get-textstyles AcDoc) "Arial-Label"))
(mapcar
'(lambda (pr val)
(vlax-put nw_style pr val)
)
(list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
(list (strcat (getenv "windir") "\\fonts\\arial.ttf") 0.0 (/ (* 15.0 pi) 180) 1.0 0.0)
)
)
)
(repeat (setq n (sslength js))
(setq
ename (ssname js (setq n (1- n)))
pt (vlax-curve-getPointAtDist ename (* 0.5 (vlax-curve-getDistAtParam ename (vlax-curve-getEndParam ename))))
deriv (vlax-curve-getFirstDeriv ename (vlax-curve-GetParamAtPoint ename pt))
rtx (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR")))
)
(if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5)))) (setq rtx (+ rtx pi)))
(cond
((ade_odgettables ename)
(if (not htx)
(progn
(initget 6)
(setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpécifiez la hauteur du texte <" (rtos (getvar "TEXTSIZE")) ">: ")))
(if htx (setvar "TEXTSIZE" htx) (setq htx (getvar "TEXTSIZE")))
)
)
(setq lst_tabl_def (mapcar 'ade_odtabledefn (ade_odgettables ename)) inc_key 0)
(foreach n lst_tabl_def
(foreach el n
(if (listp (cdr el))
(foreach sel (cdr el)
(foreach msel sel
(if (eq (car msel) "ColName")
(setq lst_def (cons (cdr msel) lst_def))
)
)
)
)
)
)
(if (not desc_od)
(setq desc_od (listbox "Donnée d'objet" "Choisir des données d'objet" (mapcar 'cons lst_def lst_def) 2) desc_tbl nil)
)
(foreach n lst_tabl_def
(foreach i desc_od
(if (assoc (cons "ColName" i) (cdaddr n))
(setq desc_tbl (cons (cdar n) desc_tbl))
)
)
)
(cond
(desc_tbl
(setq
str
(apply 'strcat
(mapcar
'(lambda (x y / w)
(setq w (ade_odgetfield ename x y 0))
(strcat
(cond
((eq (type w) 'INT) (itoa w))
((eq (type w) 'REAL) (rtos w 2 2))
((eq (type w) 'STR) w)
(T "")
)
"\\P"
)
)
desc_tbl desc_od
)
)
)
(setq nw_obj
(vla-addMtext Space
(vlax-3d-point (polar '(0.0 0.0 0.0) (* pi 0.5) (getvar "TEXTSIZE")))
0.0
str
)
)
(mapcar
'(lambda (pr val)
(vlax-put nw_obj pr val)
)
(list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
(list 4 (getvar "TEXTSIZE") 5 pt "Arial-Label" "Label" rtx)
)
)
)
)
(T (princ "\nPas de données d'objet attachées"))
)
)
(prin1)
)
