how to change the insertpoint of a block,and keep the insert objects's place

James,

What Luis said is the reason I use vlax-put, vlax-get and vlax-invoke.

I've also seen posts by Michael Puckett, while Google searching, where he said he
found those functions to be more reliable than the vla-xxx versions. Though from what
I read, Michael didn't offer specific examples.

Joe Burke

 

Hi Doug,

I guess I should know better...

What I've posted wasn't intended as a finished solution. Rather an example of one way
it might be done. Notice my in-line comments, "assume uniform scaling" twice. Thanks
for the drawing example. I'll take a look at what needs to be added to handle Y and Z
scaling.

Joe Burke

 

True. I had to add an old sample as well as a new, because none of my blocks were at 0° rotation. Although... (I'm going from memory now, so don't trust me) if the old sample was actually an existing block, adding (vla-delete obj2) before the regen line leaves you with one block not updated after you've run the routine, doesn't it?

 

Jeff,

I forgot to thank you for your speed comparison and code suggestions. So thanks.

I have a new version I'll post soon. It uses a filtered selection set, though a bit
different than your approach. I think it deals with non-uniformly scaled blocks
correctly. That wasn't particularly easy given how I'm trying to do it.

Preliminary speed tests look good. Given Doug's example of 2500 blocks to process,
I'm seeing results in the range of less than 0.7 seconds. That's not counting regen
time, which shouldn't be needed if the function behaves properly.

Regards
Joe Burke

 

My best shot at it. What did I forget or miss... surely something. ;-)

Seems fast. Timer function included.

Joe Burke

;; JB version 3 10/7/2004
;; function: move a block's insertion point and fix all existing references
;; tested in a UCS with mirrored and non-uniformly scaled blocks

(defun c:MoveBlockIP (/ doc blocks blkref oldpt newpt blkdef nm vec ang
xscl yscl zscl newvec RotatePt ScalePtNonUniform)

;; arguments: point to rotate, base point, angle
(defun RotatePt (pt bp ang)
(polar bp (+ (angle bp pt) ang) (distance bp pt))
) ;end

;; arguments: point to scale, base point, X Y and Z scale factors
(defun ScalePtNonUniform (pt bp xscl yscl zscl / vec scl)
(setq vec (mapcar '- pt bp))
(setq scl (mapcar '* vec (list xscl yscl zscl)))
(mapcar '+ scl bp)
) ;end

(setq doc (vla-get-activedocument (vlax-get-acad-object))
blocks (vla-get-blocks doc)
)
(while
(or
(not (setq blkref (car (entsel "\nSelect block: "))))
(not (setq blkref (vlax-ename->vla-object blkref)))
(not (equal "AcDbBlockReference" (vlax-get blkref 'ObjectName)))
(vlax-property-available-p blkref 'Path) ;exclude xrefs
)
(princ "\nMissed pick or wrong object type. ")
)
(initget 1)
(setq newpt (trans (getpoint "\nSelect new insertion point: ") 1 0))

;(starttimer)

(setq nm (vlax-get blkref 'Name)
blkdef (vla-item blocks nm)
xscl (/ 1.0 (vlax-get blkref 'XScaleFactor))
yscl (/ 1.0 (vlax-get blkref 'YScaleFactor))
zscl (/ 1.0 (vlax-get blkref 'ZScaleFactor))
ang (vlax-get blkref 'Rotation)
oldpt (vlax-get blkref 'InsertionPoint)
oldpt (RotatePt oldpt newpt (- ang))
oldpt (ScalePtNonUniform oldpt newpt xscl yscl zscl)
vec (mapcar '- oldpt newpt)
)

;; move objects in the block definition
(vlax-for x blkdef
(vlax-invoke x 'Move '(0.0 0.0 0.0) vec)
)

;; move block references
(ssget "x" (list '(0 . "INSERT") (cons 2 nm)))
(vlax-for x (vlax-get doc 'ActiveSelectionSet)
(setq ang (vlax-get x 'Rotation)
xscl (vlax-get x 'XScaleFactor)
yscl (vlax-get x 'YScaleFactor)
zscl (vlax-get x 'ZScaleFactor)
newvec (mapcar '* vec (list xscl yscl zscl))
newvec (RotatePt newvec '(0.0 0.0 0.0) ang)
)
(vlax-invoke x 'Move newvec '(0.0 0.0 0.0))
) ;for

;(endtimer)

(vla-regen doc acActiveViewport)
(princ)
) ;end

;---------------------------------------------------------
(defun StartTimer ()
(setq *start* (getvar "date")))
(defun EndTimer (/ end)
(setq end (* 86400 (- (getvar "date") *start*)))
(princ (strcat "\nTimer: " (rtos end 2 8) " seconds\n")))
;---------------------------------------------------------

 

BTW... my low-tech routine does handle it, because it isn't reinserting
blocks, it's redefining the block and leaving the original inserts alone.
Perhaps you could devise a more high-tech way to redefine the blocks than my
method? And get it down from 19 seconds to 3? (I'm guessing your timing
varies from mine because I'm working on a P4-1.6 machine)
-doug

 

Hi Doug,

Thanks for the feedback. I think my ignorance is showing.

I don't understand what you mean when you say "asymmetrical blocks". Does that
translate to non-uniformly scaled blocks? Worse, I'm at total loss when you say,
"blocks inserted at odd angles to the screen". I don't do 3D work, so the idea just
doesn't compute on my end.

Please know, I'm not questioning what you said. I simply don't understand it.

BTW, speed comparisons seem mostly irrelevant to me when it comes to a function like
this. It's much more important the function handles all cases correctly.

I haven't had time to study your program or James'. I will over the weekend.

Regards
Joe Burke

 

I kinda mis-spoke. I meant non-uniformly inserted blocks, not
asymmetrically. As for the odd angles comment, I just meant blocks whose
z-axis is not comin' right at ya. Like the 3d-looking block on the right. In
fact, all the blocks are the same... both circles have z-depth, but the
insertions other than the 'isometric-looking' one just appear to be 2-d
non-z type blocks.

If I follow YOUR routine correctly, it's replacing every block with a new
insertion, having determined original location and rotation of the existing
blocks, and duplicating all that with the new insertion.

MY routine simply redefines the block, leaving every pre-existing block
alone, at its original location, rotation, layer, xyz-scaling, even
attributes shouldn't change, if there are any differences within them.

Mine is slow, comparatively. But it does work.
-doug

 

BTW Doug,

I'm aware the polar function used in my RotatePt function is just 2D. So that's
obvious a concern in terms of doing things right in 3D.

Joe Burke

 

Hey Joe...
(where ya goin with that gun in your hand?)<groan>

Below is a routine I once wrote to replace a block with another one, at same
rotation, location, layer, etc. It works in 3d, since it sets UCS to the
existing block's UCS, then inserts at 0,0,0.

Again, not very sophisticated, but it does the job.
-doug

(defun c:bkr ()
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(prompt "\nChoose the block you need replaced: ")
(setq ae (entsel))
(setq aa (entget (car ae)))
(setq aaa (cdr (assoc 2 aa)))
(setq x (cdr (assoc 41 aa)))
(setq y (cdr (assoc 42 aa)))
(setq z (cdr (assoc 43 aa)))
(setq ab (strcat "\nThat is block " aaa ". "))
(princ ab)
(prompt "\nType the name of the block to replace it:<")
(if (not a)
(setq a "--")
(setq oldb a)
)
(princ a)
(prompt "> ")
(setq a (strcase (getstring)))
(if (= a "")
(setq a oldb)
)
(setq bb (strcat "\nAbout to replace block " aaa " with block " a " -
proceed? "))
(princ bb)
(setq c (getstring))
(setq d (cdr (assoc 8 aa)))
(if (or (= c "N")(= c "n"))
(prompt "\nPlease try again later. ")
(progn
(command "ucs" "e" ae)
(command "erase" ae "")
(command "-layer" "s" d "")
(command "insert" a "0,0,0" "x" x y z "")
(command "ucs" "p")
(command "redraw")
(setq f (strcat "\nBlock " a " successfully inserted in place of block "
aaa ". "))
(princ f)
)
)
(setvar "osmode" osm)
(princ)
)

 

Doug,

Regarding this:

No. That's exactly the kind of thing I'm trying to avoid.

All versions I've posted try to do two basic things. First, move the objects inside
the block definition. Second, repair the breakage for existing references by moving
them back to where they were originally. Nothing is created or erased given this
approach. Which is a point I've been keep in my back pocket while we talk.

Regards
Joe Burke

 

Gotcha.
I don't read VL very well... if at all.
I guess the only thing your routine doesn't do is establish the UCS prior to
redefining the block, and setting the UCS prior to moving each insertion.
And maybe the z isn't adjusted too.

It's not really that different than mine, (if I read it correctly<g>) it
just goes a ho lot faster! Is that the nature of VL?
-doug

 

Doug,

Aside... the idea I could move objects within a block definition relative to its
origin (0,0) was a total surprise to me. You know... one of those things you try
while thinking, "this won't work".

Regarding UCS issues, I think I took care of that. Notice (trans 1 0) at the getpoint
"Select new insertion point: " prompt. That's all that's needed here since all the
ActiveX/vlisp stuff operates in WCS. There's no need to mess with the UCS within the
program. Rather just make sure all data is in WCS. And getpoint is the possible
odd-ball.

Regards
Joe Burke

 

"...none of my blocks were at 0° rotation."
I think you are thinking of Joe's original version. Mine doesn't care how
the old and new samples are placed relative to world, just relative to each
other. And I believe his new version lifted that restriction as well.

"...adding (vla-delete obj2) ... leaves you with one block not updated ...,
doesn't it?"
Not necessarily. Let me try to make sense of this.
1. You pick the old sample (obj1) and then the new sample (obj2).
2. From these the routine determines the relative 'mapping' that will take
place.
3. You select what you want to convert (ss), or "ReplaceAll" if you intend
to effectively redefine the block.
4. The routine then converts every block in ss.

It doesn't automatically assume that obj1 is part of ss, so if you don't
select obj1 (again) in step 3 or use the "ReplaceAll" option, then you are
correct. However many instances of the old block you did not select
(potentially including obj1) will not be converted. But, if all you did
before running this was put obj2 over an *existing* obj1 and then include
obj1 in step 3, then obj2 is all you would want deleted. I hope that makes
more sense.

James

 

Hi again Joe and Doug, and whoever else may be watching. I'm back again
because once I realized the simple brilliance of Doug's approach my mind
just wouldn't let it rest. So here I am again.

I am posting two versions here. One based on Doug's method and another sort
of blend of what Joe and I were doing. I really don't know how they will
fare time-wise, but I have some other thoughts on them.

Doug, it took me a while to see what you were doing with the redefine trick,
but that's pretty slick IMHO. However, I think you should know it does have
some consequences, coming from someone who's been dwelling on it for several
days. Basically you ARE replacing every single insertion of the block with
what I'll call your pattern block (the one that gets nested). So if you
*want* every existing one in the drawing to take on the default properties
and attributes then this could be a good thing, otherwise not so good.
Depending on how you handle it, I think you could also end up with stranded
attdefs from the explode operation. I also ran into trouble with exploding
NUS blocks using vla-explode, which led me to abandon trying to use this
approach for nested occurances, which in my environment have to be allowed
for. I believe all this could be compensated for if needed, but after
trying to compensate for just some of it I think by the time you got it all
done Joe's would be the faster, and yes even easier approach after all. I
am posting my vl-version of your approach so you can see if it is any faster
if you want. I believe it does pretty much *just* what yours did, but using
vl. Pretty neat trick, and I think it does have a place.

Joe's approach would be my preferred way of handling the original request as
all <grin Joe> it does is redefine the block with the newly determined
insertion point and move all existing references back to the original
apparent position. This way no existing properties or attributes or
anything else are disturbed. And I got what I think is a nice little tool
box function out of it. Joe, I am posting my take on your version b/c I
included some other things that I think you and other's might find useful.
In cases where all you need to "transform" is a point, I expect
MWE:BlockTrans would be MUCH quicker than all the matrix functions I posted
before. On the 3D stuff, I think all you were missing was some (trans 0
enm) or vice-versa.

Please keep in mind I am just venting excess thought here. As I said my
mind just wouldn't let it go. So I thought (hope) someone else might
benefit if I share the smoldering remains of my brain. (big sigh of relief)
(okay, I can rest now) (no really... <grin>)

Code:

;;; ReConfigureBlock
;;; Doug's approach using vl- methods (mostly)
(defun c:rcb1 (/ doc obj name opt blk npt orgn tname blks tblk lst)
(setvar "cmdecho" 0)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)
(setq obj   (car (entsel "\nTouch block to reconfigure:"))
obj   (vlax-ename->vla-object obj)
name  (vla-get-name obj)
opt   (getpoint "\nPoint to a blank place to work in:")
blk   (vla-get-block (vla-get-activelayout doc))
npt   (vlax-3d-point (trans opt 1 0))
obj   (vla-insertblock blk npt name 1 1 1 0)
npt   (getpoint "\nSelect new insertion point for block:")
opt   (vlax-3d-point (mapcar '- npt opt))
npt   (vlax-3d-point (trans npt 1 0))
orgn  (vlax-3d-point '(0 0 0))
tname (strcat "RCB-Old-" name)
blks  (vla-get-blocks doc)
blk   (vla-add blks orgn tname)
tblk  (vla-item blks name)
lst   (vlax-invoke obj 'explode)
)
(prompt "\n")
(vla-delete obj)
(mapcar '(lambda (obj) (vla-move obj npt orgn)) lst)
(vlax-invoke doc 'copyobjects lst blk)
(mapcar 'vla-delete lst)
(vlax-for obj tblk (vla-delete obj))
(vla-insertblock tblk opt tname 1 1 1 0)
(ssget "x" (list '(0 . "INSERT") (cons 2 name)))
(vlax-for obj (vla-get-activeselectionset doc)
(vl-cmdf "._explode" (vlax-vla-object->ename obj) "")
)
(vl-cmdf "._purge" "B" name "N")
(vla-put-name blk name)
(vla-endundomark doc)
(princ)
)

 

It doesn't automatically assume that obj1 is part of ss, so if you

Thanks. Now it makes perfect sense. I wasn't thinking straight.

 

Hi James,

Up front, I think if you feel a need to pursue a topic, you should. Regardless of
whether it seems others are still interested or not. You just never know where a
comment might lead... or who's bell it may ring.

I gave some thought to your point about nested blocks, which I hadn't seriously
considered before. What I was doing in previous posts would cause some serious
breakage if the selected block is nested in other blocks. The block definition would
be modified, but nested references would not be moved due to the selection set
method. It only returns primary objects.

Thinking back, I believe the reason I didn't initially use Jeff's selection set idea
was because I thought I'd have to parse the model space collection eventually. IOW,
find some way to also move nested references. BTW, blocks in paper space are of no
concern to me personally.

So I'll offer this version which at least prevents making a mess when the selected
block is nested in other block definitions. See the new IsNested function. Not well
tested, but seems OK.

All of this may be moot given the methods you and Doug suggested. I still haven't
found time to study those. I must confess, any method which creates and destroys
seems less appealing than one which simply modifies existing objects. That was my
goal from the beginning. Though I certainly don't think that's the only way to do it.

Regards
Joe Burke

;; revised version 10/10/2004
;; exit if selected block is nested in other blocks
(defun c:MoveBlockIP (/ *error* doc blocks blkref oldpt newpt blkdef
nm vec ang xscl yscl zscl newvec
RotatePt ScalePtNonUniform IsNested)

(defun *error* (msg)
(if msg (princ msg))
(princ)
) ;end

;; arguments: point to rotate, base point, angle
(defun RotatePt (pt bp ang)
(polar bp (+ (angle bp pt) ang) (distance bp pt))
) ;end

;; arguments: point to scale, base point, X Y and Z scale factors
(defun ScalePtNonUniform (pt bp xscl yscl zscl / vec scl)
(setq vec (mapcar '- pt bp))
(setq scl (mapcar '* vec (list xscl yscl zscl)))
(mapcar '+ scl bp)
) ;end

;; argument: block name
;; return T if block name is nested in other blocks, otherwise nil
(defun IsNested (blknm)
(vlax-for x blocks
(vlax-for item x
(if
(and
(vlax-property-available-p item 'Name)
(equal blknm (vlax-get item 'Name))
)
T
)
)
)
) ;end

(setq doc (vla-get-activedocument (vlax-get-acad-object))
blocks (vla-get-blocks doc))

(while
(or
(not (setq blkref (car (entsel "\nSelect block: "))))
(not (setq blkref (vlax-ename->vla-object blkref)))
(not (equal "AcDbBlockReference" (vlax-get blkref 'ObjectName)))
(vlax-property-available-p blkref 'Path) ;exclude xrefs
)
(princ "\nMissed pick or wrong object type. ")
)

(setq nm (vlax-get blkref 'Name))

;; exit here if block is nested
(if (IsNested nm)
(progn
(princ "\nSelected block is nested. Exiting... ")
(exit)
)
)

(initget 1)
(setq newpt (trans (getpoint "\nSelect new insertion point: ") 1 0))

(setq blkdef (vla-item blocks nm)
xscl (/ 1.0 (vlax-get blkref 'XScaleFactor))
yscl (/ 1.0 (vlax-get blkref 'YScaleFactor))
zscl (/ 1.0 (vlax-get blkref 'ZScaleFactor))
ang (vlax-get blkref 'Rotation)
oldpt (vlax-get blkref 'InsertionPoint)
oldpt (RotatePt oldpt newpt (- ang))
oldpt (ScalePtNonUniform oldpt newpt xscl yscl zscl)
vec (mapcar '- oldpt newpt)
)

;; move objects in the block definition
(vlax-for x blkdef
(vlax-invoke x 'Move '(0.0 0.0 0.0) vec)
)

;; move block references
(ssget "x" (list '(0 . "INSERT") (cons 2 nm)))
(vlax-for x (vlax-get doc 'ActiveSelectionSet)
(setq ang (vlax-get x 'Rotation)
xscl (vlax-get x 'XScaleFactor)
yscl (vlax-get x 'YScaleFactor)
zscl (vlax-get x 'ZScaleFactor)
newvec (mapcar '* vec (list xscl yscl zscl))
newvec (RotatePt newvec '(0.0 0.0 0.0) ang)
)
(vlax-invoke x 'Move newvec '(0.0 0.0 0.0))
) ;for

(vla-regen doc acActiveViewport)
(*error* nil)
) ;end

 

BTW James,

I was tempted to get into matrix transformations here. I decided against it, thinking
such would just obscure the primary topic.

Others have mentioned vla-explode with NUS blocks under recent versions doesn't work
as expected.

Forgive me if I'm repeating myself. I don't think speed is an issue here. It's an
issue with a function which may be repeated often. This one is not one of those. As I
see it, speed is totally subservient to doing the thing right in all cases.

Regards
Joe Burke

 

Hi James,

Somehow I missed your attachment RCB2 while reading this before. Nice work! Seems to
work perfectly, as far as I've tested it. Guess I might as well junk my stuff.

One suggestion. I think it would be helpful to highlight the selected block before
asking for new insertion point. Something like this.

(setq obj (vlax-ename->vla-object
(car (entsel "\nTouch block to reconfigure:"))))
(vla-highlight obj :vlax-true)
(setq npt (getpoint "\nSelect new insertion point for block:")
etc...

So it's clear when dealing with nested blocks, which block's insertion point is being
modified. Someone, like me, might think they can pick a nested block.

I also wonder about moving the block's origin point. That was something I played with
early on. I had some trouble getting a handle on exactly what it meant it terms of
what we are doing. Then I thought why not move the objects in the block definition,
which leaves the origin at 0,0,0. Obviously that's what I did eventually.

Whether the distinction between the two methods makes any difference in practice is
questionable. I guess some programmer, like us, might assume a block's origin is
always 0,0,0 since AFAIK there's no way to create a block with an origin other than
that using standard tools.

Something makes me uneasy about the idea. Given the fact there is an alternate method
which leaves origin point at 0,0,0.

BTW, I encountered some problems with RCB1. I haven't looked at it closely. When it
worked, it seemed to change the layer of modified blocks to the current layer. When
it didn't work, for some unknown reason (nested blocks?), I got this:

Unknown command "RCB1". Press F1 for help.
No unreferenced blocks found.
; error: Automation Error. Duplicate record name

I'm also looking at your MWE:BlockTrans function. Needs some quiet time to study.
Don't know when that will happen. But it's actually of more interest to me than this
subject.

Regards
Joe Burke

 

Am I missing something here? Of course you can create a block with an
origin other than 0,0,0 using standard tools:

[in A2K4]
Command: -block
Enter block name or [?]: <..give it something..>
Specify insertion base point: <..wherever you want..>

The dialog box offers 0,0,0 as a default, but there's the Pick Point button,
also in Wblock.

Somehow -wblock still gives you a file dialog box if FILEDIA is 1, but if
it's 0, then:

Command: -WBLOCK
Enter name of output file: <..give it something..>
Enter name of existing block or
[= (block=output file)/* (whole drawing)] <define new drawing>: <..Enter..>
Specify insertion base point: <..wherever you want..>

Or are you talking about something different than what I think of as
"creating a block"?
--
Kent Cooper, AIA


...
....

....