Just to start:
; Marc'Antonio Alessi, Italy - http://xoomer.virgilio.it/alessi
;
; Function: ALE_Block_GetInsertByPos
;
; Version 1.00 - 02/05/2008
;
; Arguments:
; LayNam: Layout name > "Model"
; LyrNms: Layer names > "Layer1,Layer2*" or "*" for all - [Wcmatch string]
; BlkNam: Block name > "Block001"
; Prmlst: (Function Coord) > '(> cadr) = find the block with the higher value of Y (of insert point)
; > '(< car) = find the block with the lower value of X (of insert point)
;
; Return Values: VLA obj
;
; Example:
; (ALE_Block_GetInsertByPos *AcAcDwg* "Model" "*" "Block001" '(> cadr))
;
; Custom functions: ALE_Utl_GetItem
;
(defun ALE_Block_GetInsertByPos (VlaDoc LayNam LyrNms BlkNam PrmLst / VlaObj LayObj BlkObj TmpCrd LstCrd Ss_Tmp Countr EntNam)
(if (= ">" (vl-symbol-name (car PrmLst))) (setq LstCrd -1e99) (setq LstCrd 1e99))
(cond
( (not (= 'VLA-OBJECT (type VlaDoc))) )
( (and
(vl-catch-all-error-p (vl-catch-all-apply 'vla-get-ActiveLayer (list VlaDoc)))
(setq LayObj (ALE_Utl_GetItem (vla-get-layouts VlaDoc) LayNam))
)
(vlax-for ObjFor (vla-get-block LayObj)
(and
(= (vla-get-objectname ObjFor) "AcDbBlockReference") ; Block Reference (Insert)
(not (vlax-property-available-p ObjFor 'Path)) ; not Xref - UNICA DIFFERENZA -
(wcmatch (strcase (vla-get-Layer ObjFor)) (strcase LyrNms))
(= (strcase (vla-get-Name ObjFor)) (strcase BlkNam))
( (eval (car PrmLst))
(setq TmpCrd ((eval (cadr PrmLst)) (safearray-value (vlax-variant-value (vla-get-InsertionPoint ObjFor)))))
LstCrd
)
(setq LstCrd TmpCrd BlkObj ObjFor)
)
)
)
( (setq Ss_Tmp (ssget "_X" (list '(0 . "INSERT") (cons 410 LayNam) (cons 8 LyrNms) (cons 2 BlkNam) '(66 . 1))))
(repeat (setq Countr (sslength Ss_Tmp))
(and
(setq VlaObj (vlax-ename->vla-object (setq EntNam (ssname Ss_Tmp (setq Countr (1- Countr))))))
(not (vlax-property-available-p VlaObj 'Path)) ; not Xref - UNICA DIFFERENZA -
( (eval (car PrmLst))
(setq TmpCrd ((eval (cadr PrmLst)) (safearray-value (vlax-variant-value (vla-get-InsertionPoint VlaObj)))))
LstCrd
)
(setq LstCrd TmpCrd BlkObj VlaObj)
)
)
)
)
BlkObj
)
; Function: ALE_Utl_GetItem
;
; Arguments:
; VlaCol = Collection Object > ex. (vla-get-Layers *AcAcDwg*)
; KeyNam = String > "0"
;
; Return Values:
; VLA-OBJECT or nil if (vla-item) fails
;
; Note:
; the Item method is case-sensitive when used with the SelectionSets
; collection it is not case-sensitive for other collections.
;
; Example:
; (ALE_Utl_GetItem
; (vla-get-Layers (vla-get-ActiveDocument (vlax-get-Acad-Object)))
; "0"
; )
;
(defun ALE_Utl_GetItem (VlaCol KeyNam / VlaObj)
(vl-catch-all-apply
'(lambda ( )
(setq VlaObj (vla-item VlaCol KeyNam))
)
)
VlaObj
)
