(ssget "x" '((0 . "LINE") (-3 ("Appname1" "Appname2"))))
What is the equivalent in ActiveX/Vlisp?
I wrote the following function and I thought it could also incorporate extended data entity but it returned a vlax-safearray-fill error. I know that using the above to get the entities and convert to a vla-object is much easier. But I am just curious and to further improve my understanding of activex/vlisp safearray, I hope to get some answers from you guys. The following function is the result I have learnt from this forum and is a compilation of functions obtained from here. And I must say, I have improved my programming skills and a big thanks to all of you.
;;
;; wg:SelectObjects
;; USAGE:
;; Arguments
;; Nme = Selection set name - [STR}
;; Mde = Select mode [INT] (1)
;; - Constants:
;; - acSelectionSetWindow - 0
;; - acSelectionSetCrossing - 1
;; - acSelectionSetPrevious - 3
;; - acSelectionSetLast - 4
;; - acSelectionAll - 5
;; Pt1 - First window corner [LIST} (2)
;; Pt2 - Next window corner [LIST} (2)
;; whatobjects = Dotted pair list of filtered entities to be selected
;; Returns - [LIST]
;; Returns a list of the objects that match the filter list
;; USAGE :
;; eg. (wg:GEtObjectsOnScreen-list GB:ActivedocumentObj (list '(0 . "INSERT")))
;; eg. (wg:GEtObjectsOnScreen-list GB:ActivedocumentObj
;; (list '(-4 . "<OR")'(0 . "CIRCLE")
;; '(0 . "ARC")'(-4 . "OR>")))
;; Requires
;; wg:NewNameSelectionSet Function
;; wg:SsetFilter Function
;; wg:VariantArrayToList function
;;
;;
(defun wg:SelectObjects-list (Nme Mde Pt1 Pt2 whatobjects /
objects-list
ssObj
FstPnt NxtPnt FltList
filter_what?
)
(setq ssObj (wg:NewNameSelectionSet Nme)
FstPnt (cond (Pt1 (vlax-3d-Point Pt1))(T nil))
NxtPnt (cond (Pt2 (vlax-3d-Point Pt2))(T nil))
FltList (cond (whatobjects (wg:SsetFilter whatobjects))(T nil))
)
(if Mde
(if FltList
(vla-Select ssobj Mde FstPnt NxtPnt (car FltList)(cadr FltList))
(vla-Select ssobj Mde FstPnt NxtPnt)
)
(if FltList
(progn
(setq filter_what? (mapcar 'vlax-variant-value
(wg:VariantArrayToList (cadr fltlist))))
(setq filter_what? (subst "BLOCK" "INSERT"
(vl-remove "AND>"
(vl-remove "<AND"
(vl-remove "OR>"
(vl-remove "<OR" filter_what?))))
))
(prompt "\nPls select ")(princ (vl-sort filter_what? '<))
(princ " objects....")
(vla-SelectOnScreen ssobj (car FltList)(cadr FltList))
)
(vla-SelectOnScreen ssobj)
)
)
(setq objects-list '())
(vlax-for eachobj ssobj
(setq objects-list(cons eachobj objects-list))
)
objects-list
) ; wg:SelectObjects-list
;;
;; wg:SsetFilter
;; Creates a filter for the SelectXXX methods
;; Arguments
;; Flt = Dotted pair list '((0 . "Name"). . .(8 . "LAYER")) - [LIST]
;; Returns
;; List of two arrays '(TypArr DatArr) - [LIST]
;; Requires
;; wg:ListToVariantArray function
;;
(defun wg:SsetFilter (Flt)
(mapcar
; this lambda needs 2 lists
'(lambda (Typ Dat) (wg:ListToVariantArray Typ Dat))
(list 2 12)
(list (mapcar 'car Flt)
(mapcar 'cdr Flt))
)
); wg:SsetFilter
;;
;; converts an array to list
;; Argument
;; Arr = Variant Array [VARIANT]
;; Returns [TYP]
;; - Standard List [LIST]
;; - nil if array is empty
;;
(defun wg:VariantArrayToList ( Arr / TmpVal)
(setq TmpVal (vlax-variant-value Arr))
(if (safearray-value Tmpval)
(vlax-safearray->list Tmpval)
'()
)
);wg:VariantArrayToList
;;
;; Converts list into variant safearray
;; Argument
;; Lst = Standard list [LIST]
;; Typ = Datatype [INT]
;; - constants
;; - vlax-vbBoolean
;; - vlax-vbDecimal *
;; - vlax-vbDouble
;; - vlax-vbInteger
;; - vlax-vbLong
;; - vlax-vbObject
;; - vlax-vbSingle
;; - vlax-vbString
;; - vlax-vbVariant
;; Return [TYP]
;; - Array [VARIANT]
;; Cannot be used for dotted pair or nested lists
;;
(defun wg:ListToVariantArray (Typ Lst)
(vlax-make-variant (vlax-safearray-fill
(vlax-make-safearray Typ (cons 0 (1- (length Lst))))
Lst
)
)
); wg:ListToVariantArray
;; -----------------------------------------------
;; wg:NewNameSelectionSet
;; USAGE:
;; (wg:NewNameSelectionSet "Name of SS")
;; Returns a vla-object of selection set
;; 26-12-05
;;
(defun wg:NewNameSelectionSet(SelSetName / ssCollection)
(setq ssColection (vla-get-selectionsets GB:ActivedocumentObj))
(setq SelSetName (vlax-make-variant SelSetname))
(if (vl-catch-all-error-p
(vl-catch-all-apply 'vla-item (list ssColection SelSetName))
)
(vla-add ssColection SelSetName)
(progn
(vla-delete (vla-item ssColection SelSetName))
(vla-add ssColection SelSetName)
)
) ;_if
); wg:NewNameSelectionSet
(defun c:test()
(setq GB:ActivedocumentObj (vla-get-Activedocument
(vlax-get-acad-object))
allobects (wg:SelectObjects-List "SS1" 5 nil nil
(list '(-4 . "<OR")'(0 . "LINE")'(0 . "INSERT")
'(-4 . "<AND")
'(0 . "TEXT")'(8 . "1")
'(-4 . "AND>")
'(-4 . "OR>")))
)
)
(defun c:test1()
(setq GB:ActivedocumentObj (vla-get-Activedocument
(vlax-get-acad-object))
allobects (wg:SelectObjects-List "SS1" 5 nil nil
(setq a (list '(0 . "LINE") '(-3 ("test1"))))
)
)
)
