Author Topic: Reactive point on body of entity?  (Read 3999 times)

0 Members and 1 Guest are viewing this topic.

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Reactive point on body of entity?
« on: December 19, 2014, 08:22:15 AM »
Hi all,

Greetings to all fellows here on the swamp... I have one question on which I seems can't find adequate answer... Supose I have an entity in 3D space... I am interested in this: Can I and how aquire reactive point on that entity which describes it at its body without picking it with a mouse? Supose I have 2d or 3d curve, I could easily get it by (vlax-curve-getstartpoint curve), or if entity is a point, then easiest would be (cdr (assoc 10 (entget point)))... But what if I have REGION or even better 3D SOLID entity, I just can't figure out what that point meight be - its not centroid as if nothing isn't passing it I would get nil from (nentselp centroid)... So is there something I am missing and that is stored into data of each entity like this reactive point... I need this because I want to make better my recently coded routine for refeditbyname. And to make it work not only on blocks/xrefs that contain some curve entity I need to find this point for every different entity to make it possible to achieve picking definitions reference without using mouse, just by its name... If you have some opinion on this subject I am all your beloved puppy with ears cleaning the floor behind you...

Thanks...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Reactive point on body of entity?
« Reply #1 on: December 19, 2014, 05:25:55 PM »
I almost did what I wanted, only there is one small thing... When ATTDEF or *TEXT entity is selected I can get reactive points, but they don't lie on graphical body of entity - bounding box is correct, but its not reactive - when I use (nentselp (car l)) or (netselp (cadr l)) or (nentselp (caddr l)) or (nentselp (cadddr l)) I always get nil... That's one part of the story, but I want to implement this procedure on entity(ies) that are stored in Block/Xref definitions, so for 3D SOLIDS, MLINES, REGIONS I need processing of multiple command calls that are at the end undone with undo - back command and I want it to be done inside definition SPACE... So here are my routines :
First that is buggy for TEXTs and what I want to get - list of reactive points :
Code: [Select]
(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...
Code: [Select]
;;---------------------=={ 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)
)

For now REFEDITBYNAME works only for curves in definitions, and I would like if someone can continue to develop on my basis... Priority is implementation for other entity types, and if its possible to find some fix for ATTDEFs and *TEXTs - that's not so important for now... My primary goal is to make it possible for Xrefs that are made from 3DSOLIDs and that do not contain curves...

Please, help if you can...
Thanks, M.R.
« Last Edit: May 13, 2016, 06:59:39 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Reactive point on body of entity?
« Reply #2 on: December 20, 2014, 04:56:09 AM »
Hi, I've changed a little (c:getreactpoints) - section for 3DSOLID... Any thoughts, ideas, advice? :mrgreen:
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Rod

  • Newt
  • Posts: 185
Re: Reactive point on body of entity?
« Reply #3 on: December 20, 2014, 06:57:05 AM »
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?
"All models are wrong, some models are useful" - George Box

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Reactive point on body of entity?
« Reply #4 on: December 20, 2014, 07:01:29 AM »
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?

Do you have a quick example how to obtain that reactive point from entity name... If I supply (nentselp reactivept) I should get list with (ename reactivept)... Is this info available and for 3DSOLID entity?
« Last Edit: December 20, 2014, 07:07:52 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Reactive point on body of entity?
« Reply #5 on: December 20, 2014, 07:11:27 AM »
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.

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Reactive point on body of entity?
« Reply #6 on: December 20, 2014, 07:19:52 AM »
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.

Yes Roy, I mean clickable point...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Reactive point on body of entity?
« Reply #7 on: December 20, 2014, 07:30:49 AM »
To find these points for 3D solids inside a block definition you obviously cannot rely on command calls. But if you look through an entity list of a 3D solid you can find point values.
Code: [Select]
...
(1 . "point $-1 -1 $-1 2345.9455475743089 1855.0536092334189 0.45174828767022246 #")
...

But even if you solve this there other issues that need to be addressed:
1.
Zoom to the reference? Will there be clutter there?
2.
What if the first curve inside the block is on a frozen layer?
3.
What if the block definition contains only nested inserts or only texts?
4.
What if the block definition only occurs as nested inserts.
5.
The reason you are required to select a point is to determine the nesting level for the _REFEDIT command. How would you handle that?

I personally would not invest time in trying to enhance the _REFEDIT command in this manner.

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Reactive point on body of entity?
« Reply #8 on: December 20, 2014, 08:12:02 AM »
Roy, can you explain how you obtained that posted list from 3DSOLID... As for your info ab many issues that needs to be considered, I mean to only improve refeditbyname in that way it can handle Xrefs with only 3DSOLIDS or curves or 3DSOLIDS with curves... As for frozen layers, you are right, but some entity in reference is needed to be thawed - otherwise - complete Xref would be uneditable... In my refeditbyname I should perform (command "_.-REFEDIT" pt "Ok") with each entity in definition - some of them in reference must be visible, so picking by name will be possible... I am interested in this as I may use Xrefs with 3DSOLIDs while my modelling work, and it would be nice if I could refedit them by name... I am planing to use only Xrefs that don't contain nesting of other type entities - so "Ok" will be just fine, and as I said texts are not important for my job right now, but if its possible why not improve it and for this situations... Zooming will be just extents of found Xref/Block reference that is editable, so that's not big deal... I've added (command "_.ZOOM" "_O" ref "") line inside refeditbyname.lsp, it should work as desired...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Reactive point on body of entity?
« Reply #9 on: December 20, 2014, 01:20:50 PM »
After some very deep thinking, I've found solution that looks dumb, but on the other hand, when modelling is the task, it looks very promising... As I said its very simple... I've added this 2 codes into my startup :

Code: [Select]
(defun c:m0 nil
  (entmake (list '(0 . "LINE") '(10 0.0 0.0 0.0) '(11 0.0 0.0 0.0)))
  (princ)
)

Code: [Select]
(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)
)

So now when some 3D xref or 3D block is to be created, its necessary to type first "d0", zoom extents and type "m0" and that's it... Now REFEDITBYNAME will always work as it is like I posted... At the end when modelling is finished and xrefs are bind and exploded as also blocks are exploded you just need to type "d0" and zoom extents... Finished...

If this method is somewhat stupid and you have something to say to me, please don't hesitate... I know its dumb, but I think that some sort of compromise had to be made ab this subject... Few extra steps, but if correctly stick with procedure, success is the award by my humble opinion...
« Last Edit: May 13, 2016, 04:43:31 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Reactive point on body of entity?
« Reply #10 on: January 07, 2015, 08:48:52 AM »
I am reviving this topic again in search for opinions...

This code "refeditbyname.lsp" would be much more simple if someone from Autodesk would be able to make insertion points of Blocks/Xrefs/Texts reactive - I mean - when clicked on snap "ins" the object would be selected, or when (ssget inspt) return would be selection set with referenced object in it... I was just thinking what would be minimal intervention if AutoCAD is to be improved and my conclusion is this what I've explained... So I am thinking now, are there some disadvantages for such implementation of reactive insertion points, I mean when working is this bad for some reason, or is this still good idea for proposal for Wish list at www.augi.com...

Any opinions are welcomed...
Look there are new smileys, thanks Mark... :grinwink: :wideeyed2:
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Reactive point on body of entity?
« Reply #11 on: January 07, 2015, 04:08:23 PM »
What you call a 'minimal intervention' would constitute a fundamental change to the AutoCAD GUI. Even if your wish is feasible it is unlikely to ever become a reality.

Compare: You can't select a dashed line by clicking on a gap between two dashes.

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Reactive point on body of entity?
« Reply #12 on: January 07, 2015, 06:25:42 PM »
Compare: You can't select a dashed line by clicking on a gap between two dashes.

Just a one more lack that Autodesk has to resolve... IMHO...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Reactive point on body of entity?
« Reply #13 on: May 13, 2016, 07:06:19 AM »
I did find some quick way to avoid this problem for REFEDITBYNAME for Block references - not Xrefs and that may have or not curve entities inside them, which is just what I needed for usage with 3DSOLID entities inside Block(s)... So here is it :

Code - Auto/Visual Lisp: [Select]
  1. ;;----------------=={ Add Object to Block }==-----------------;;
  2. ;;                                                            ;;
  3. ;;  Add single object in the provided ENAME definition to     ;;
  4. ;;  definition of the specified block.                        ;;
  5. ;;------------------------------------------------------------;;
  6. ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
  7. ;;  slightly modified by M.R. for his purposes                ;;
  8. ;;------------------------------------------------------------;;
  9. ;;  Arguments:                                                ;;
  10. ;;  doc   - Document Object in which block resides.           ;;
  11. ;;  block - Entity name of reference insert                   ;;
  12. ;;  ent   - Object to add to definition [ENAME]               ;;
  13. ;;------------------------------------------------------------;;
  14.  
  15. (defun LM:AddObjecttoBlock ( doc block ent / mat vlaentblk )
  16.  
  17.   (setq ent (vlax-ename->vla-object ent)
  18.         mat (LM:Ref->Def block)
  19.         mat (vlax-tmatrix (append (mapcar 'append (car mat) (mapcar 'list (cadr mat))) '((0. 0. 0. 1.))))
  20.   )
  21.   (vla-transformby ent mat)
  22.  
  23.   (setq vlaentblk
  24.     (car
  25.       (safearray-value
  26.         (variant-value
  27.           (vla-CopyObjects doc (LM:SafearrayVariant vlax-vbobject (list ent))
  28.             (vla-item (vla-get-Blocks doc) (cdr (assoc 2 (entget block))))
  29.           )
  30.         )
  31.       )
  32.     )
  33.   )
  34.   (vla-delete ent)
  35.   (vla-regen doc acAllViewports)
  36.   vlaentblk
  37. )
  38.  
  39. ;;-----------------=={ Remove From Block }==------------------;;
  40. ;;                                                            ;;
  41. ;;  Removes an Entity from a Block Definition                 ;;
  42. ;;------------------------------------------------------------;;
  43. ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
  44. ;;------------------------------------------------------------;;
  45. ;;  Arguments:                                                ;;
  46. ;;  ent - Entity name of Object to Delete from Block [ENAME]  ;;
  47. ;;------------------------------------------------------------;;
  48.  
  49. (defun LM:RemovefromBlock ( doc ent )
  50.   (vla-delete (vlax-ename->vla-object ent))
  51.   (vla-regen doc acAllViewports)
  52.   (princ)
  53. )
  54.  
  55. ;;------------------=={ Safearray Variant }==-----------------;;
  56. ;;                                                            ;;
  57. ;;  Creates a populated Safearray Variant of a specified      ;;
  58. ;;  data type                                                 ;;
  59. ;;------------------------------------------------------------;;
  60. ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
  61. ;;------------------------------------------------------------;;
  62. ;;  Arguments:                                                ;;
  63. ;;  datatype - variant type enum (eg vlax-vbDouble)           ;;
  64. ;;  data     - list of static type data                       ;;
  65. ;;------------------------------------------------------------;;
  66. ;;  Returns:  VLA Variant Object of type specified            ;;
  67. ;;------------------------------------------------------------;;
  68.  
  69. (defun LM:SafearrayVariant ( datatype data )
  70.   (vlax-make-variant
  71.       (vlax-make-safearray datatype (cons 0 (1- (length data)))) data
  72.     )    
  73.   )
  74. )
  75.  
  76. ;;---------------=={ Block Ref -> Block Def }==---------------;;
  77. ;;                                                            ;;
  78. ;;  Returns the Transformation Matrix and Translation Vector  ;;
  79. ;;  for transforming Block Reference Geometry to the Block    ;;
  80. ;;  Definiton.                                                ;;
  81. ;;------------------------------------------------------------;;
  82. ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
  83. ;;------------------------------------------------------------;;
  84. ;;  Arguments:                                                ;;
  85. ;;  e - Block Reference Entity                                ;;
  86. ;;------------------------------------------------------------;;
  87. ;;  Returns:  List of 3x3 Transformation Matrix, Vector       ;;
  88. ;;------------------------------------------------------------;;
  89.  
  90. (defun LM:Ref->Def ( e / _dxf a l n )
  91.  
  92.   (defun _dxf ( x l ) (cdr (assoc x l)))
  93.  
  94.   (setq l (entget e) a (- (_dxf 50 l)) n (_dxf 210 l))
  95.   (
  96.     (lambda ( m )
  97.       (list m
  98.         (mapcar '- (_dxf 10 (tblsearch "BLOCK" (_dxf 2 l)))
  99.           (mxv m
  100.             (trans (_dxf 10 l) n 0)
  101.           )
  102.         )
  103.       )
  104.     )
  105.     (mxm
  106.       (list
  107.         (list (/ 1. (_dxf 41 l)) 0. 0.)
  108.         (list 0. (/ 1. (_dxf 42 l)) 0.)
  109.         (list 0. 0. (/ 1. (_dxf 43 l)))
  110.       )
  111.       (mxm
  112.         (list
  113.           (list (cos a) (sin (- a)) 0.)
  114.           (list (sin a) (cos a)     0.)
  115.           (list    0.        0.     1.)
  116.         )
  117.         (mapcar '(lambda ( e ) (trans e n 0 t))
  118.          '(
  119.             (1. 0. 0.)
  120.             (0. 1. 0.)
  121.             (0. 0. 1.)
  122.           )
  123.         )
  124.       )
  125.     )
  126.   )
  127. )
  128.  
  129. ;;---------------------=={ WCS->Geom }==----------------------;;
  130. ;;                                                            ;;
  131. ;;  Returns the Transformation Matrix and Translation Vector  ;;
  132. ;;  for transforming Block Definition Geometry to a Block     ;;
  133. ;;  Reference.                                                ;;
  134. ;;------------------------------------------------------------;;
  135. ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
  136. ;;------------------------------------------------------------;;
  137. ;;  Arguments:                                                ;;
  138. ;;  SourceBlock - VLA Block Reference Object                  ;;
  139. ;;------------------------------------------------------------;;
  140. ;;  Returns:  List of 3x3 Transformation Matrix, Vector       ;;
  141. ;;------------------------------------------------------------;;
  142.  
  143. (defun LM:WCS->Geom (SourceBlock / norm ang x y z)
  144.   ;; © Lee Mac 2010
  145.   (setq norm (vlax-get SourceBlock 'Normal)
  146.         ang  (vla-get-rotation SourceBlock)
  147.   )
  148.   (mapcar 'set
  149.           '(x y z)
  150.           (mapcar '(lambda (prop alt)
  151.                      (vlax-get-property
  152.                        SourceBlock
  153.                        (if (vlax-property-available-p SourceBlock prop)
  154.                          prop
  155.                          alt
  156.                        )
  157.                      )
  158.                    )
  159.                   '(XEffectiveScaleFactor
  160.                     YEffectiveScaleFactor
  161.                     ZEffectiveScaleFactor
  162.                    )
  163.                   '(XScaleFactor YScaleFactor ZScaleFactor)
  164.           )
  165.   )
  166.   ( (lambda (m)
  167.       (list
  168.         m
  169.         (mapcar
  170.           '-
  171.           (vlax-get SourceBlock 'InsertionPoint)
  172.           (mxv
  173.             m
  174.             (cdr
  175.               (assoc 10 (tblsearch "BLOCK" (vla-get-name SourceBlock)))
  176.             )
  177.           )
  178.         )
  179.       )
  180.     )
  181.     (mxm (mapcar '(lambda (e) (trans e 0 norm t))
  182.                  '((1. 0. 0.) (0. 1. 0.) (0. 0. 1.))
  183.          )
  184.          (mxm (list (list (cos ang) (sin (- ang)) 0.)
  185.                     (list (sin ang) (cos ang) 0.)
  186.                     (list 0. 0. 1.)
  187.               )
  188.               (list (list x 0. 0.) (list 0. y 0.) (list 0. 0. z))
  189.          )
  190.     )
  191.   )
  192. )
  193.  
  194. ;;-----------=={ Apply Matrix Transformation }==--------------;;
  195. ;;                                                            ;;
  196. ;;  Transforms a VLA-Object or Point List using a             ;;
  197. ;;  Transformation Matrix                                     ;;
  198. ;;------------------------------------------------------------;;
  199. ;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
  200. ;;------------------------------------------------------------;;
  201. ;;  Arguments:                                                ;;
  202. ;;  target - VLA-Object or Point List to Transform            ;;
  203. ;;  matrix - 3x3 Matrix by which to Transform object          ;;
  204. ;;  vector - 3D translation vector                            ;;
  205. ;;------------------------------------------------------------;;
  206.  
  207. (defun LM:ApplyMatrixTransformation (target matrix vector)
  208.   ;; © Lee Mac 2010
  209.   (cond
  210.     ( (eq 'VLA-OBJECT (type target))
  211.       (vla-TransformBy
  212.         target
  213.         (vlax-tMatrix
  214.           (append
  215.             (mapcar '(lambda (x v) (append x (list v))) matrix vector)
  216.             '((0. 0. 0. 1.))
  217.           )
  218.         )
  219.       )
  220.     )
  221.     ( (listp target)
  222.       (mapcar (function
  223.                (lambda (point) (mapcar '+ (mxv matrix point) vector))
  224.              )
  225.              target
  226.       )
  227.     )
  228.   )
  229. )
  230.  
  231. ;; Matrix x Vector - Lee Mac 2010
  232. ;; Args: m - nxn matrix, v - vector in R^n
  233.  
  234. (defun mxv (m v)
  235.   (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
  236. )
  237.  
  238. ;; Matrix x Matrix - Lee Mac 2010
  239. ;; Args: m,n - nxn matrices
  240.  
  241. (defun mxm (m n)
  242.   ((lambda (a) (mapcar '(lambda (r) (mxv a r)) m)) (trp n))
  243. )
  244.  
  245. ;; Matrix Transpose - Lee Mac 2010
  246. ;; Args: m - nxn matrix
  247.  
  248. (defun trp (m) (apply 'mapcar (cons 'list m)))
  249.  
  250. (defun c:refeditblkbyname ( / loop def ss i ref defent p el ent entvla )
  251.   (setq def (dos_listbox
  252.               "BLOCK/XREF"
  253.               "Select Block - NOT Xref definition"
  254.               (ai_table "BLOCK" 4)
  255.             )
  256.   )
  257.   (while (= 4 (logand 4 (cdr (assoc 70 (tblsearch "BLOCK" def)))))
  258.     (alert "Selected definition belongs to XREF... Please choose Block definition...")
  259.     (setq def (dos_listbox
  260.                 "BLOCK/XREF"
  261.                 "Select Block - NOT Xref definition"
  262.                 (ai_table "BLOCK" 4)
  263.               )
  264.     )
  265.   )
  266.   (if (and def
  267.            (setq ss (ssget "_A"
  268.                            (list '(0 . "INSERT")
  269.                                  (cons 2 def)
  270.                                  (cons 410
  271.                                        (if (= 1 (getvar 'cvport))
  272.                                          (getvar 'ctab)
  273.                                          "Model"
  274.                                        )
  275.                                  )
  276.                            )
  277.                     )
  278.            )
  279.       )
  280.     (progn
  281.       ;; "_A" mode - excluded objects on frozen layers ;; 410 DXF code quiery for only entities on current space
  282.       (setq loop t
  283.             i 0
  284.       )
  285.       (while (and loop (> (sslength ss) i))
  286.         (setq el (entlast))
  287.         (setq ref (ssname ss i))
  288.         (if
  289.           (or
  290.             (not
  291.               (and
  292.                 (equal (vla-get-xscalefactor (vlax-ename->vla-object ref)) (vla-get-yscalefactor (vlax-ename->vla-object ref))
  293.                     1e-8
  294.                 )
  295.                 (equal (vla-get-yscalefactor (vlax-ename->vla-object ref)) (vla-get-zscalefactor (vlax-ename->vla-object ref))
  296.                     1e-8
  297.                 )
  298.                 (equal (vla-get-zscalefactor (vlax-ename->vla-object ref)) (vla-get-xscalefactor (vlax-ename->vla-object ref))
  299.                     1e-8
  300.                 )
  301.               )
  302.             )
  303.             (=
  304.               4
  305.               (logand
  306.                 4
  307.                 (cdr
  308.                   (assoc 70
  309.                          (tblsearch "LAYER" (cdr (assoc 8 (entget ref))))
  310.                   )
  311.                 )
  312.               )
  313.             )
  314.           )
  315.           (setq i (1+ i))
  316.           (progn
  317.             (setq loop nil)
  318.             (setq defent (entnext (tblobjname "BLOCK" def)))
  319.             (while
  320.               (and
  321.                 defent
  322.                 (or
  323.                   (vl-catch-all-error-p
  324.                     (setq p (vl-catch-all-apply
  325.                               'vlax-curve-getstartpoint
  326.                               (list defent)
  327.                             )
  328.                     )
  329.                   )
  330.                   (=
  331.                     1
  332.                     (logand
  333.                       1
  334.                       (cdr
  335.                         (assoc 70
  336.                                (tblsearch "LAYER"
  337.                                           (cdr (assoc 8 (entget defent)))
  338.                                )
  339.                         )
  340.                       )
  341.                     )
  342.                   )
  343.                 )
  344.               )
  345.               (setq defent (entnext defent))
  346.             )
  347.             (if (not (vl-catch-all-error-p p))
  348.               (progn
  349.                 (command "_.ZOOM" "_O" ref "")
  350.                 (command "_.ZOOM" "0.5xp")
  351.                 (command
  352.                   "_.-REFEDIT"
  353.                   (trans
  354.                     (car
  355.                       (LM:ApplyMatrixTransformation
  356.                         (list p)
  357.                         (car (LM:WCS->Geom (vlax-ename->vla-object ref))
  358.                         )
  359.                         (cadr (LM:WCS->Geom (vlax-ename->vla-object ref))
  360.                         )
  361.                       )
  362.                     )
  363.                     0
  364.                     1
  365.                   )
  366.                   "Ok"
  367.                 )
  368.                 (while (< 0 (getvar 'cmdactive))
  369.                   (command "")
  370.                 )
  371.               )
  372.               (progn
  373.                 (setq p (trans (cdr (assoc 10 (entget ref))) ref 0))
  374.                 (setq ent (entmakex (list '(0 . "LINE") (cons 10 p) (cons 11 p))))
  375.                 (setq entvla (LM:AddObjecttoBlock (vla-get-activedocument (vlax-get-acad-object)) ref ent))
  376.                 (vla-update (vlax-ename->vla-object ref))
  377.                 (setq p (vlax-curve-getstartpoint entvla))
  378.                 (command "_.ZOOM" "_O" ref "")
  379.                 (command "_.ZOOM" "0.5xp")
  380.                 (command
  381.                   "_.-REFEDIT"
  382.                   (trans
  383.                     (car
  384.                       (LM:ApplyMatrixTransformation
  385.                         (list p)
  386.                         (car (LM:WCS->Geom (vlax-ename->vla-object ref))
  387.                         )
  388.                         (cadr (LM:WCS->Geom (vlax-ename->vla-object ref))
  389.                         )
  390.                       )
  391.                     )
  392.                     0
  393.                     1
  394.                   )
  395.                   "Ok"
  396.                 )
  397.                 (while (< 0 (getvar 'cmdactive))
  398.                   (command "")
  399.                 )
  400.                 (if (and (not (eq el (entlast))) (= (cdr (assoc 0 (entget (entlast)))) "LINE") (equal (distance (cdr (assoc 10 (entget (entlast)))) (cdr (assoc 11 (entget (entlast))))) 0.0 1e-8))
  401.                   (entdel (entlast))
  402.                 )
  403.                 (if (not (vlax-erased-p entvla))
  404.                   (vla-delete entvla)
  405.                 )
  406.               )
  407.             )
  408.           )
  409.         )
  410.       )
  411.     )
  412.   )
  413.   (princ)
  414. )
  415.  

M.R.
« Last Edit: June 10, 2016, 09:49:17 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Reactive point on body of entity?
« Reply #14 on: May 14, 2016, 11:32:58 AM »
Here is my final version - it's called REFEDITBYNAME... Watch that this routine have no conflicts with previous I posted... Some definitions are equally named, so I've lost much time today until I figured out that it was conflict in my acaddoc.lsp where I've put those... - now I just have this version...

Code - Auto/Visual Lisp: [Select]
  1. ;;-------------=={ Add Object to Block/Xref }==---------------;;
  2. ;;                                                            ;;
  3. ;;  Add single object in the provided ENAME definition to     ;;
  4. ;;  definition of the specified block/xref.                   ;;
  5. ;;------------------------------------------------------------;;
  6. ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
  7. ;;  slightly modified by M.R. for his purposes                ;;
  8. ;;------------------------------------------------------------;;
  9. ;;  Arguments:                                                ;;
  10. ;;  acd   - Document Object in which block resides.           ;;
  11. ;;  block - Entity name of reference insert                   ;;
  12. ;;  ent   - Object to add to definition [ENAME]               ;;
  13. ;;------------------------------------------------------------;;
  14.  
  15. (defun LM:AddObjecttoBlock ( acd block ent / mat dbx app vrs dwg doc dwl err )
  16.  
  17.   (setq ent (vlax-ename->vla-object ent)
  18.         mat (LM:Ref->Def block)
  19.         mat (vlax-tmatrix (append (mapcar 'append (car mat) (mapcar 'list (cadr mat))) '((0.0 0.0 0.0 1.0))))
  20.   )
  21.   (vla-transformby ent mat)
  22.  
  23.   (if (= (vla-get-isxref (vla-item (vla-get-blocks acd) (cdr (assoc 2 (entget block))))) :vlax-false)
  24.     (vla-copyobjects acd (LM:SafearrayVariant vlax-vbobject (list ent))
  25.       (vla-item (vla-get-blocks acd) (cdr (assoc 2 (entget block))))
  26.     )
  27.     (progn
  28.       (cond
  29.         (   (progn
  30.                (setq dbx
  31.                    (vl-catch-all-apply 'vla-getinterfaceobject
  32.                        (list (setq app (vlax-get-acad-object))
  33.                            (if (< (setq vrs (atoi (getvar 'acadver))) 16)
  34.                                "objectdbx.axdbdocument" (strcat "objectdbx.axdbdocument." (itoa vrs))
  35.                            )
  36.                        )
  37.                    )
  38.                )
  39.                (or (null dbx) (vl-catch-all-error-p dbx))
  40.             )
  41.             (prompt "\nUnable to interface with ObjectDBX.")
  42.         )
  43.         (   (not
  44.                 (and
  45.                     (setq dwg (cdr (assoc 1 (tblsearch "BLOCK" (cdr (assoc 2 (entget block)))))))
  46.                     (setq dwg (findfile dwg))
  47.                 )
  48.             )
  49.             (prompt "\nUnable to locate xref source drawing.")
  50.         )
  51.         (   (progn
  52.                 (vlax-for doc (vla-get-documents app)
  53.                     (setq dwl (cons (cons (strcase (vla-get-fullname doc)) doc) dwl))
  54.                 )
  55.                 (not
  56.                     (or (setq doc (cdr (assoc (strcase dwg) dwl)))
  57.                         (and (not (vl-catch-all-error-p (setq err (vl-catch-all-apply 'vla-open (list dbx dwg)))))
  58.                              (setq doc dbx)
  59.                         )
  60.                     )
  61.                 )
  62.             )
  63.             (prompt (strcat "\nUnable to interface with xref source drawing:\n" (vl-catch-all-error-message err)))
  64.         )
  65.       )
  66.       (vlax-invoke acd 'copyobjects (list ent) (vla-get-modelspace doc))
  67.       (vla-saveas doc dwg)
  68.       (vla-reload (vla-item (vla-get-blocks acd) (cdr (assoc 2 (entget block)))))
  69.       (if (and (= 'vla-object (type dbx)) (not (vlax-object-released-p dbx)))
  70.         (vlax-release-object dbx)
  71.       )
  72.     )
  73.   )
  74.  
  75.   (if (and ent (= 'vla-object (type ent)))
  76.     (vla-delete ent)
  77.     (if (and ent (entget ent))
  78.       (entdel ent)
  79.     )
  80.   )
  81. )
  82.  
  83. ;;-----------------=={ Remove From Block }==------------------;;
  84. ;;                                                            ;;
  85. ;;  Removes an Entity from a Block Definition                 ;;
  86. ;;------------------------------------------------------------;;
  87. ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
  88. ;;------------------------------------------------------------;;
  89. ;;  Arguments:                                                ;;
  90. ;;  ent - Entity name of Object to Delete from Block [ENAME]  ;;
  91. ;;------------------------------------------------------------;;
  92.  
  93. (defun LM:RemovefromBlock ( doc ent )
  94.   (vla-delete (vlax-ename->vla-object ent))
  95.   (vla-regen doc acAllViewports)
  96.   (princ)
  97. )
  98.  
  99. ;;------------------=={ Safearray Variant }==-----------------;;
  100. ;;                                                            ;;
  101. ;;  Creates a populated Safearray Variant of a specified      ;;
  102. ;;  data type                                                 ;;
  103. ;;------------------------------------------------------------;;
  104. ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
  105. ;;------------------------------------------------------------;;
  106. ;;  Arguments:                                                ;;
  107. ;;  datatype - variant type enum (eg vlax-vbDouble)           ;;
  108. ;;  data     - list of static type data                       ;;
  109. ;;------------------------------------------------------------;;
  110. ;;  Returns:  VLA Variant Object of type specified            ;;
  111. ;;------------------------------------------------------------;;
  112.  
  113. (defun LM:SafearrayVariant ( datatype data )
  114.   (vlax-make-variant
  115.       (vlax-make-safearray datatype (cons 0 (1- (length data)))) data
  116.     )    
  117.   )
  118. )
  119.  
  120. ;;---------------=={ Block Ref -> Block Def }==---------------;;
  121. ;;                                                            ;;
  122. ;;  Returns the Transformation Matrix and Translation Vector  ;;
  123. ;;  for transforming Block Reference Geometry to the Block    ;;
  124. ;;  Definiton.                                                ;;
  125. ;;------------------------------------------------------------;;
  126. ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
  127. ;;------------------------------------------------------------;;
  128. ;;  Arguments:                                                ;;
  129. ;;  e - Block Reference Entity                                ;;
  130. ;;------------------------------------------------------------;;
  131. ;;  Returns:  List of 3x3 Transformation Matrix, Vector       ;;
  132. ;;------------------------------------------------------------;;
  133.  
  134. (defun LM:Ref->Def ( e / _dxf a l n )
  135.  
  136.   (defun _dxf ( x l ) (cdr (assoc x l)))
  137.  
  138.   (setq l (entget e) a (- (_dxf 50 l)) n (_dxf 210 l))
  139.   (
  140.     (lambda ( m )
  141.       (list m
  142.         (mapcar '- (_dxf 10 (tblsearch "BLOCK" (_dxf 2 l)))
  143.           (mxv m
  144.             (trans (_dxf 10 l) n 0)
  145.           )
  146.         )
  147.       )
  148.     )
  149.     (mxm
  150.       (list
  151.         (list (/ 1. (_dxf 41 l)) 0. 0.)
  152.         (list 0. (/ 1. (_dxf 42 l)) 0.)
  153.         (list 0. 0. (/ 1. (_dxf 43 l)))
  154.       )
  155.       (mxm
  156.         (list
  157.           (list (cos a) (sin (- a)) 0.)
  158.           (list (sin a) (cos a)     0.)
  159.           (list    0.        0.     1.)
  160.         )
  161.         (mapcar '(lambda ( e ) (trans e n 0 t))
  162.          '(
  163.             (1. 0. 0.)
  164.             (0. 1. 0.)
  165.             (0. 0. 1.)
  166.           )
  167.         )
  168.       )
  169.     )
  170.   )
  171. )
  172.  
  173. ;;---------------------=={ WCS->Geom }==----------------------;;
  174. ;;                                                            ;;
  175. ;;  Returns the Transformation Matrix and Translation Vector  ;;
  176. ;;  for transforming Block Definition Geometry to a Block     ;;
  177. ;;  Reference.                                                ;;
  178. ;;------------------------------------------------------------;;
  179. ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
  180. ;;------------------------------------------------------------;;
  181. ;;  Arguments:                                                ;;
  182. ;;  SourceBlock - VLA Block Reference Object                  ;;
  183. ;;------------------------------------------------------------;;
  184. ;;  Returns:  List of 3x3 Transformation Matrix, Vector       ;;
  185. ;;------------------------------------------------------------;;
  186.  
  187. (defun LM:WCS->Geom (SourceBlock / norm ang x y z)
  188.   ;; © Lee Mac 2010
  189.   (setq norm (vlax-get SourceBlock 'Normal)
  190.         ang  (vla-get-rotation SourceBlock)
  191.   )
  192.   (mapcar 'set
  193.           '(x y z)
  194.           (mapcar '(lambda (prop alt)
  195.                      (vlax-get-property
  196.                        SourceBlock
  197.                        (if (vlax-property-available-p SourceBlock prop)
  198.                          prop
  199.                          alt
  200.                        )
  201.                      )
  202.                    )
  203.                   '(XEffectiveScaleFactor
  204.                     YEffectiveScaleFactor
  205.                     ZEffectiveScaleFactor
  206.                    )
  207.                   '(XScaleFactor YScaleFactor ZScaleFactor)
  208.           )
  209.   )
  210.   ( (lambda (m)
  211.       (list
  212.         m
  213.         (mapcar
  214.           '-
  215.           (vlax-get SourceBlock 'InsertionPoint)
  216.           (mxv
  217.             m
  218.             (cdr
  219.               (assoc 10 (tblsearch "BLOCK" (vla-get-name SourceBlock)))
  220.             )
  221.           )
  222.         )
  223.       )
  224.     )
  225.     (mxm (mapcar '(lambda (e) (trans e 0 norm t))
  226.                  '((1. 0. 0.) (0. 1. 0.) (0. 0. 1.))
  227.          )
  228.          (mxm (list (list (cos ang) (sin (- ang)) 0.)
  229.                     (list (sin ang) (cos ang) 0.)
  230.                     (list 0. 0. 1.)
  231.               )
  232.               (list (list x 0. 0.) (list 0. y 0.) (list 0. 0. z))
  233.          )
  234.     )
  235.   )
  236. )
  237.  
  238. ;;-----------=={ Apply Matrix Transformation }==--------------;;
  239. ;;                                                            ;;
  240. ;;  Transforms a VLA-Object or Point List using a             ;;
  241. ;;  Transformation Matrix                                     ;;
  242. ;;------------------------------------------------------------;;
  243. ;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
  244. ;;------------------------------------------------------------;;
  245. ;;  Arguments:                                                ;;
  246. ;;  target - VLA-Object or Point List to Transform            ;;
  247. ;;  matrix - 3x3 Matrix by which to Transform object          ;;
  248. ;;  vector - 3D translation vector                            ;;
  249. ;;------------------------------------------------------------;;
  250.  
  251. (defun LM:ApplyMatrixTransformation (target matrix vector)
  252.   ;; © Lee Mac 2010
  253.   (cond
  254.     ( (eq 'VLA-OBJECT (type target))
  255.       (vla-TransformBy
  256.         target
  257.         (vlax-tMatrix
  258.           (append
  259.             (mapcar '(lambda (x v) (append x (list v))) matrix vector)
  260.             '((0.0 0.0 0.0 1.0))
  261.           )
  262.         )
  263.       )
  264.     )
  265.     ( (listp target)
  266.       (mapcar (function
  267.                (lambda (point) (mapcar '+ (mxv matrix point) vector))
  268.              )
  269.              target
  270.       )
  271.     )
  272.   )
  273. )
  274.  
  275. ;; Matrix x Vector - Lee Mac 2010
  276. ;; Args: m - nxn matrix, v - vector in R^n
  277.  
  278. (defun mxv (m v)
  279.   (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
  280. )
  281.  
  282. ;; Matrix x Matrix - Lee Mac 2010
  283. ;; Args: m,n - nxn matrices
  284.  
  285. (defun mxm (m n)
  286.   ((lambda (a) (mapcar '(lambda (r) (mxv a r)) m)) (trp n))
  287. )
  288.  
  289. ;; Matrix Transpose - Lee Mac 2010
  290. ;; Args: m - nxn matrix
  291.  
  292. (defun trp (m) (apply 'mapcar (cons 'list m)))
  293.  
  294. (defun c:refeditbyname ( / *error* *adoc* loop xl pck def ss i ref defent p el ent )
  295.  
  296.  
  297.   (defun *error* ( m )
  298.     (if xl
  299.       (setvar 'xloadctl xl)
  300.     )
  301.     (if pck
  302.       (setvar 'pickbox pck)
  303.     )
  304.     (vla-regen *adoc* acactiveviewport)
  305.     (vla-endundomark *adoc*)
  306.     (if m
  307.       (prompt m)
  308.     )
  309.     (princ)
  310.   )
  311.  
  312.   (alert "You are refediting Block/Xref... Please click SAVE changes button after finish even you didn't made change...")
  313.   (setq xl (getvar 'xloadctl))
  314.   (setvar 'xloadctl 2)
  315.   (setq pck (getvar 'pickbox))
  316.   (setvar 'pickbox 4)
  317.   (setq def (dos_listbox
  318.               "BLOCK/XREF"
  319.               "Select Block - Xref definition"
  320.               (ai_table "BLOCK" 4)
  321.            )
  322.   )
  323.   (command "_.ZOOM" "_E")
  324.   (command "_.ZOOM" "_V")
  325.   (if (and def
  326.            (setq ss (ssget "_A"
  327.                            (list '(0 . "INSERT")
  328.                                  (cons 2 def)
  329.                                  (cons 410
  330.                                        (if (= 1 (getvar 'cvport))
  331.                                          (getvar 'ctab)
  332.                                          "Model"
  333.                                        )
  334.                                  )
  335.                            )
  336.                     )
  337.            )
  338.       )
  339.     (progn
  340.       ;; "_A" mode - excluded objects on frozen layers ;; 410 DXF code quiery for only entities on current space
  341.       (setq loop t
  342.             i 0
  343.       )
  344.       (while (and loop (> (sslength ss) i))
  345.         (setq el (entlast))
  346.         (setq ref (ssname ss i))
  347.         (if
  348.           (or
  349.             (not
  350.               (and
  351.                 (equal (vla-get-xscalefactor (vlax-ename->vla-object ref)) (vla-get-yscalefactor (vlax-ename->vla-object ref))
  352.                     1e-8
  353.                 )
  354.                 (equal (vla-get-yscalefactor (vlax-ename->vla-object ref)) (vla-get-zscalefactor (vlax-ename->vla-object ref))
  355.                     1e-8
  356.                 )
  357.                 (equal (vla-get-zscalefactor (vlax-ename->vla-object ref)) (vla-get-xscalefactor (vlax-ename->vla-object ref))
  358.                     1e-8
  359.                 )
  360.               )
  361.             )
  362.             (=
  363.               4
  364.               (logand
  365.                 4
  366.                 (cdr
  367.                   (assoc 70
  368.                          (tblsearch "LAYER" (cdr (assoc 8 (entget ref))))
  369.                   )
  370.                 )
  371.               )
  372.             )
  373.           )
  374.           (setq i (1+ i))
  375.           (progn
  376.             (setq loop nil)
  377.             (setq defent (entnext (tblobjname "BLOCK" def)))
  378.             (while
  379.               (and
  380.                 defent
  381.                 (or
  382.                   (vl-catch-all-error-p
  383.                     (setq p (vl-catch-all-apply
  384.                               'vlax-curve-getstartpoint
  385.                               (list defent)
  386.                             )
  387.                     )
  388.                   )
  389.                   (=
  390.                     1
  391.                     (logand
  392.                       1
  393.                       (cdr
  394.                         (assoc 70
  395.                                (tblsearch "LAYER"
  396.                                           (cdr (assoc 8 (entget defent)))
  397.                                )
  398.                         )
  399.                       )
  400.                     )
  401.                   )
  402.                 )
  403.               )
  404.               (setq defent (entnext defent))
  405.             )
  406.             (if (not (vl-catch-all-error-p p))
  407.               (progn
  408.                 (vla-update (vlax-ename->vla-object ref))
  409.                 (command "_.ZOOM" "_O" ref "")
  410.                 (command "_.ZOOM" "0.5xp")
  411.                 (command
  412.                   "_.-REFEDIT"
  413.                   (trans
  414.                     (car
  415.                       (LM:ApplyMatrixTransformation
  416.                         (list p)
  417.                         (car (LM:WCS->Geom (vlax-ename->vla-object ref)))
  418.                         (cadr (LM:WCS->Geom (vlax-ename->vla-object ref)))
  419.                       )
  420.                     )
  421.                     0
  422.                     1
  423.                   )
  424.                   "Ok"
  425.                 )
  426.                 (while (< 0 (getvar 'cmdactive))
  427.                   (command "")
  428.                 )
  429.               )
  430.               (progn
  431.                 (setq p (trans (cdr (assoc 10 (entget ref))) ref 0))
  432.                 (setq ent (entmakex (list '(0 . "LINE") (cons 10 p) (cons 11 p))))
  433.                 (LM:AddObjecttoBlock *adoc* ref ent)
  434.                 (vla-update (vlax-ename->vla-object ref))
  435.                 (command "_.ZOOM" "_O" ref "")
  436.                 (command "_.ZOOM" "0.5xp")
  437.                 (command
  438.                   "_.-REFEDIT"
  439.                   (trans p 0 1)
  440.                   "Ok"
  441.                 )
  442.                 (while (< 0 (getvar 'cmdactive))
  443.                   (command "")
  444.                 )
  445.                 (if (and (not (eq el (entlast))) (= (cdr (assoc 0 (entget (entlast)))) "LINE") (equal (distance (cdr (assoc 10 (entget (entlast)))) (cdr (assoc 11 (entget (entlast))))) 0.0 1e-8))
  446.                   (entdel (entlast))
  447.                 )
  448.               )
  449.             )
  450.           )
  451.         )
  452.       )
  453.     )
  454.   )
  455.   (*error* nil)
  456. )
  457.  

HTH, M.R.

BTW. All this to make it work with 3DSOLID entities inside blocks/xrefs... So you can edit in place 3D blocks and manipulate them as like with 3D xrefs...
« Last Edit: June 10, 2016, 09:48:04 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube