(defun c:getreactpoints ( / msp adoc unique ent typ p p1 p2 ll x y z minpt maxpt sol bbox el )
(vl-load-com)
(setq l nil)
(setq msp (vla-get-block (vla-get-activelayout (setq adoc (vla-get-activedocument (vlax-get-acad-object))))))
(vla-startundomark adoc)
(defun unique ( l )
(if l (cons (car l) (vl-remove-if '(lambda ( x ) (equal (car l) x 1e-8)) (unique (cdr l)))))
)
(prompt "\nPick entity to obtain reactive points")
(setq ent (ssname (ssget "_+.:E:S:L") 0))
(setq typ (cdr (assoc 0 (entget ent))))
(cond
( (eq typ "POINT")
(setq p (cdr (assoc 10 (entget ent))))
(setq l (list p))
)
( (eq typ "MLINE")
(setq el (entlast))
(command "_.EXPLODE" ent)
(while (setq el (entnext el))
(setq p1 (vlax-curve-getstartpoint el))
(setq p2 (vlax-curve-getendpoint el))
(setq l (cons p1 l) l (cons p2 l))
)
(setq l (reverse l))
(command "_.UNDO" "_B")
)
( (not (vl-catch-all-error-p (setq p (vl-catch-all-apply 'vlax-curve-getstartpoint (list ent)))))
(setq l (list p (vlax-curve-getendpoint ent)))
)
( (or (eq typ "ATTDEF") (wcmatch typ "*TEXT"))
(setq ll (vlax-safearray->list (vlax-variant-value (vla-intersectwith (vlax-ename->vla-object ent) (vlax-ename->vla-object ent) acextendnone))))
(repeat (/ (length ll) 3)
(setq x (car ll))
(setq y (cadr ll))
(setq z (caddr ll))
(setq l (cons (list x y z) l))
(setq ll (cdddr ll))
)
(setq l (reverse l))
)
( (eq typ "3DSOLID")
(vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt)
(setq minpt (vlax-safearray->list minpt) maxpt (vlax-safearray->list maxpt))
(setq bbox (vla-addbox msp (vlax-3d-point (mapcar '/ (mapcar '+ minpt maxpt) '(2.0 2.0 2.0))) (- (car maxpt) (car minpt)) (- (cadr maxpt) (cadr minpt)) (- (caddr maxpt) (caddr minpt))))
(command "_.CONVTOSURFACE" ent "")
(setq sol (entlast))
(command "_.CONVTOSURFACE" (vlax-vla-object->ename bbox) "")
(setq bbox (entlast))
(setq el (entlast))
(command "_.INTERSECT" (ssadd bbox (ssadd sol)) "")
(if (eq (cdr (assoc 0 (entget (entlast)))) "SURFACE")
(progn
(setq el (entlast))
(command "_.EXPLODE" el)
(foreach et (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_P"))))
(if (vl-catch-all-error-p (setq ll (vl-catch-all-apply 'vlax-safearray->list (list (vl-catch-all-apply 'vlax-variant-value (list (vl-catch-all-apply 'vla-intersectwith (list (vlax-ename->vla-object et) (vlax-ename->vla-object et) acextendnone))))))))
(progn
(command "_.EXPLODE" et)
(foreach el (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_P"))))
(if (not (vl-catch-all-error-p (setq ll (vl-catch-all-apply 'vlax-safearray->list (list (vl-catch-all-apply 'vlax-variant-value (list (vl-catch-all-apply 'vla-intersectwith (list (vlax-ename->vla-object el) (vlax-ename->vla-object el) acextendnone)))))))))
(repeat (/ (length ll) 3)
(setq x (car ll))
(setq y (cadr ll))
(setq z (caddr ll))
(setq l (cons (list x y z) l))
(setq ll (cdddr ll))
)
(progn
(setq p1 (vlax-curve-getstartpoint el))
(setq p2 (vlax-curve-getendpoint el))
(setq l (cons p1 l) l (cons p2 l))
)
)
)
)
(progn
(repeat (/ (length ll) 3)
(setq x (car ll))
(setq y (cadr ll))
(setq z (caddr ll))
(setq l (cons (list x y z) l))
(setq ll (cdddr ll))
)
)
)
)
(setq l (reverse l))
)
(progn
(while (setq el (entnext el))
(setq p (cdr (assoc 10 (entget el))))
(setq l (cons p l))
)
)
)
(command "_.UNDO" "_B")
)
( (eq typ "REGION")
(setq el (entlast))
(if (vl-catch-all-error-p (setq ll (vl-catch-all-apply 'vlax-safearray->list (list (vl-catch-all-apply 'vlax-variant-value (list (vl-catch-all-apply 'vla-intersectwith (list (vlax-ename->vla-object ent) (vlax-ename->vla-object ent) acextendnone))))))))
(progn
(command "_.EXPLODE" ent)
(while (setq el (entnext el))
(if (not (vl-catch-all-error-p (setq ll (vl-catch-all-apply 'vlax-safearray->list (list (vl-catch-all-apply 'vlax-variant-value (list (vl-catch-all-apply 'vla-intersectwith (list (vlax-ename->vla-object el) (vlax-ename->vla-object el) acextendnone)))))))))
(repeat (/ (length ll) 3)
(setq x (car ll))
(setq y (cadr ll))
(setq z (caddr ll))
(setq l (cons (list x y z) l))
(setq ll (cdddr ll))
)
(progn
(setq p1 (vlax-curve-getstartpoint el))
(setq p2 (vlax-curve-getendpoint el))
(setq l (cons p1 l) l (cons p2 l))
)
)
)
(setq l (reverse l))
(command "_.UNDO" "_B")
)
(progn
(repeat (/ (length ll) 3)
(setq x (car ll))
(setq y (cadr ll))
(setq z (caddr ll))
(setq l (cons (list x y z) l))
(setq ll (cdddr ll))
)
(setq l (reverse l))
)
)
)
)
(setq l (unique l))
(princ l)
(prompt "\nReactive points are stored in variable l - call it with !l")
(princ)
)
And the second one is actually REFEDITBYNAME - the routine where I want to do implementation of reactive points that are transformed from definition SPACE to reference SPACE and also in some user active UCS...;;---------------------=={ WCS->Geom }==----------------------;;
;; ;;
;; Returns the Transformation Matrix and Translation Vector ;;
;; for transforming Block Definition Geometry to a Block ;;
;; Reference. ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; SourceBlock - VLA Block Reference Object ;;
;;------------------------------------------------------------;;
;; Returns: List of 3x3 Transformation Matrix, Vector ;;
;;------------------------------------------------------------;;
(defun LM:WCS->Geom (SourceBlock / norm ang x y z)
;; © Lee Mac 2010
(vl-load-com)
(setq norm (vlax-get SourceBlock 'Normal)
ang (vla-get-rotation SourceBlock)
)
(mapcar 'set
'(x y z)
(mapcar '(lambda (prop alt)
(vlax-get-property
SourceBlock
(if (vlax-property-available-p SourceBlock prop)
prop
alt
)
)
)
'(XEffectiveScaleFactor
YEffectiveScaleFactor
ZEffectiveScaleFactor
)
'(XScaleFactor YScaleFactor ZScaleFactor)
)
)
( (lambda (m)
(list
m
(mapcar
'-
(vlax-get SourceBlock 'InsertionPoint)
(mxv
m
(cdr
(assoc 10 (tblsearch "BLOCK" (vla-get-name SourceBlock)))
)
)
)
)
)
(mxm (mapcar '(lambda (e) (trans e 0 norm t))
'((1. 0. 0.) (0. 1. 0.) (0. 0. 1.))
)
(mxm (list (list (cos ang) (sin (- ang)) 0.)
(list (sin ang) (cos ang) 0.)
(list 0. 0. 1.)
)
(list (list x 0. 0.) (list 0. y 0.) (list 0. 0. z))
)
)
)
)
;;-----------=={ Apply Matrix Transformation }==--------------;;
;; ;;
;; Transforms a VLA-Object or Point List using a ;;
;; Transformation Matrix ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2010 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; target - VLA-Object or Point List to Transform ;;
;; matrix - 3x3 Matrix by which to Transform object ;;
;; vector - 3D translation vector ;;
;;------------------------------------------------------------;;
(defun LM:ApplyMatrixTransformation (target matrix vector)
(vl-load-com)
;; © Lee Mac 2010
(cond
( (eq 'VLA-OBJECT (type target))
(vla-TransformBy
target
(vlax-tMatrix
(append
(mapcar '(lambda (x v) (append x (list v))) matrix vector)
'((0. 0. 0. 1.))
)
)
)
)
( (listp target)
(mapcar (function
(lambda (point) (mapcar '+ (mxv matrix point) vector))
)
target
)
)
)
)
;; Matrix x Vector - Lee Mac 2010
;; Args: m - nxn matrix, v - vector in R^n
(defun mxv (m v)
(mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
)
;; Matrix x Matrix - Lee Mac 2010
;; Args: m,n - nxn matrices
(defun mxm (m n)
((lambda (a) (mapcar '(lambda (r) (mxv a r)) m)) (trp n))
)
;; Matrix Transpose - Lee Mac 2010
;; Args: m - nxn matrix
(defun trp (m) (apply 'mapcar (cons 'list m)))
(defun c:refeditbyname (/ def ss i ref defent p)
(vl-load-com)
(setq def (dos_listbox
"BLOCK/XREF"
"Select Block/Xref definition"
(ai_table "BLOCK" 4)
)
)
(if (and def
(setq ss (ssget "_A"
(list '(0 . "INSERT")
(cons 2 def)
(cons 410
(if (= 1 (getvar 'cvport))
(getvar 'ctab)
"Model"
)
)
)
)
)
)
(progn
;; "_A" mode - excluded objects on frozen layers ;; 410 DXF code quiery for only entities on current space
(setq loop t
i 0
)
(while (and loop (> (sslength ss) i))
(setq ref (ssname ss i))
(if
(or
(not
(and
(eq (vla-get-xscalefactor (vlax-ename->vla-object ref))
1.0
)
(eq (vla-get-yscalefactor (vlax-ename->vla-object ref))
1.0
)
(eq (vla-get-zscalefactor (vlax-ename->vla-object ref))
1.0
)
)
)
(eq
4
(logand
4
(cdr
(assoc 70
(tblsearch "LAYER" (cdr (assoc 8 (entget ref))))
)
)
)
)
)
(setq i (1+ i))
(progn
(setq loop nil)
(setq defent (entnext (tblobjname "BLOCK" def)))
(while
(and
defent
(or
(vl-catch-all-error-p
(setq p (vl-catch-all-apply
'vlax-curve-getstartpoint
(list defent)
)
)
)
(eq
1
(logand
1
(cdr
(assoc 70
(tblsearch "LAYER"
(cdr (assoc 8 (entget defent)))
)
)
)
)
)
)
)
(setq defent (entnext defent))
)
(if (not (vl-catch-all-error-p p))
(progn
(command "_.ZOOM" "_O" ref "")
(command "_.ZOOM" "0.5xp")
(command
"_.-REFEDIT"
(trans
(car
(LM:ApplyMatrixTransformation
(list p)
(car (LM:WCS->Geom (vlax-ename->vla-object ref))
)
(cadr (LM:WCS->Geom (vlax-ename->vla-object ref))
)
)
)
0
1
)
"Ok"
)
(while (> (getvar 'cmdactive) 0) (command ""))
)
(prompt
"\nNo entity in selected Block/Xref definition isn't curve entity... Can't process REFEDITBYNAME with such definition..."
)
)
)
)
)
)
)
(princ)
)
Not entirely sure i follow you completely but some of the xdata points are reactive. For example an xdata point with code 1011 is moved, mirrored, scaled and rotated along with its host object, is that what you are after?
I think there is some confusion about the term 'reactive point'. What ribarm means by this term is a point on an entity that can be used to select it (a clickable point). At least that is what I think he means. This has nothing to do with Xdata.
...
(1 . "point $-1 -1 $-1 2345.9455475743089 1855.0536092334189 0.45174828767022246 #")
...
(defun c:m0 nil
(entmake (list '(0 . "LINE") '(10 0.0 0.0 0.0) '(11 0.0 0.0 0.0)))
(princ)
)
(defun c:d0 ( / ss i li )
(if (setq ss (ssget "_X" '((0 . "LINE"))))
(repeat (setq i (sslength ss))
(setq li (ssname ss (setq i (1- i))))
(if (equal (cdr (assoc 10 (entget li))) (cdr (assoc 11 (entget li))) 1e-50)
(entdel li)
)
)
)
(princ)
)
Compare: You can't select a dashed line by clicking on a gap between two dashes.