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

Thanks, Gary.

I hope it passes testing among the crew.

It isn't what I thought would work at first. Moving the block references
after-the-fact seems like a kludge. Not to mention, a bit code intensive.

Joe Burke

 

Doug,

I'd like to hear what others report, before commenting on your point. Frankly, I'm
confused... which is nothing new.

Regards
Joe Burke

 

I just tried this out on HUW's drawing and one of mine. Provided the
directions are followed (use a block insert at 0 degrees rotation) I found
nothing wrong with it.....here's my ID dump:
Command: '_id Specify point: _cen of X = 3.21246107E+08 Y =
5.81521357E+09 Z = 0.00000000

Command: ID Specify point: _ins of X = 3.21246107E+08 Y =
5.81521357E+09 Z = 0.00000000

When I selected one of the blocks already in the drawing I could duplicate
the error.....but then I wouldn't be following directions...... ;-)

 

I guess Jeff found the same problem in Huw's drawing.

Here's my solution to the original question - scales and rotations
of blocks remain the same, only the definition has changed.
-doug

;;; ReConfigureBlock
(defun c:rcb ()
(setvar "cmdecho" 0)
(princ "\nTouch block to reconfigure:")
(setq orig-name (cdr (assoc 2 (entget (car (entsel))))))
(princ "\nPoint to a blank place to work in:")
(setq workpoint (getpoint))
(command "-INSERT" orig-name workpoint "" "" "")
(command "explode" "L" "")
(princ "\nSelect new insertion point for block:")
(setq newpoint (getpoint))
(princ "\nRe-Select entities for block:")
(setq blockparts (ssget))
(cond
((not (tblsearch "block" "TEMP1"))(setq temp "TEMP1"))
((not (tblsearch "block" "TEMP2"))(setq temp "TEMP2"))
((not (tblsearch "block" "TEMP3"))(setq temp "TEMP3"))
)
(command "-block" temp newpoint blockparts "")
(command "-insert" temp newpoint "" "" "")
(command "-block" orig-name "Y" workpoint (entlast) "")
(setq orig-blocks (ssget "X" (list (cons 0 "INSERT")(cons 2 orig-name))))
(setq n 0)
(while (setq orig-block (ssname orig-blocks n))
(command "explode" orig-block)
(setq n (1+ n))
)
(command "-purge" "B" orig-name "N")
(command "rename" "B" temp orig-name)
(princ)
)

 

Well, I tried all three routines posted...

Douglas' RCB worked, but moved all the blocks to layer 0 - a problem (for me) given that there can be valves on both High Pressure and Low Pressure layers. (I know, I didn't think to mention that before. Sorry)

Joe's MoveBlockIP moved the IP, but not to the picked location - the new location wasn't always repeatable either. If I used UNDO and tried again on the same block the new IP sometimes appeared in a different wrong place to the previous attempt. It seemed to be affected by middlebutton pans and zooms in between selecting the block and picking the desired new IP.

James' BlockSwap worked well, but did leave the sample new block to be deleted manually. There might have been a problem correctly selecting the old and new blocks had their geometry been identical, but my new block was smaller.

Please don't take any of this as criticism, it's all intended as useful feedback for you coders. Many thanks for all your interest, my problem is solved.

Huw

 

James' BlockSwap worked well, but did leave the sample new block to

In fact it left both samples, but had resized the sample old block to match the new one and I didn't see it there underneath. That makes more sense and is obviously deliberate.

 

My routine uses the standard 'explode' command. I attempted to instead use
the command 'xplode', asking the explosion to inherit properties, retaining
original layers for the entities within the block, but I can't get it to
utilize the command. Perhaps someone else knows how to get 'xplode' to work
within another lisp.
-doug

 

Actually, I forgot to add this line right before the regen line:

(vla-delete obj2)

I see no reason to keep the sample new block. Adding this line just before
the regen will clean it up.

had their geometry been identical,...

This had occurred to me. I chose to leave it to the user to use ctrl
(object cycling) if necessary while selecting. Of course if they are also
the same color, then even the cycling would be hard to use.

Thank you for the feedback. And you are very welcome.

James

 

Huw,

RE: "Joe's MoveBlockIP moved the IP, but not to the picked location". I suspect you
missed or forgot my instructions regarding the block used had to be not scaled or
rotated under the version I posted previously.

Whatever, here's a revised version which doesn't impose that restriction. You can
select a block regardless of scale and/or rotation. It's what I should have posted in
the first place. I just didn't have time to work out the details last night. There's
better error checking in this version. And the supporting functions are also revised.

Jeff,

If you have a chance, please test this one. TIA

Joe Burke

;; JB 10/5/2004 revised version 2
;; function: move a block's insertion point
;; designed for model space blocks
(defun c:MoveBlockIP (/ doc blocks mspace blkref oldpt newpt
blkdef nm refscl refang vec ang scl modvec RotatePt ScalePt)

(defun RotatePt (pt bp ang)
(polar bp (+ (angle bp pt) ang) (distance bp pt))
) ;end

(defun ScalePt (pt bp scale / vec scl)
(setq vec (mapcar '- pt bp))
(setq scl (mapcar '(lambda (x) (* x scale)) vec))
(mapcar '+ scl bp)
) ;end

(setq doc (vla-get-activedocument (vlax-get-acad-object))
blocks (vla-get-blocks doc)
mspace (vla-get-ModelSpace 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 selected. ")
)

(setq nm (vlax-get blkref 'Name))
(setq blkdef (vla-item blocks nm))
;; assume uniform scaling
(setq refscl (vlax-get blkref 'XScaleFactor))
(setq refang (vlax-get blkref 'Rotation))
(setq oldpt (vlax-get blkref 'InsertionPoint))
(setq newpt (trans (getpoint "\nSelect new insertion point: ") 1 0))
(setq oldpt (ScalePt oldpt newpt (/ 1.0 refscl)))
(setq oldpt (RotatePt oldpt newpt (- refang)))
(setq 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
(vlax-for x mspace
(if
(and
(equal "AcDbBlockReference" (vlax-get x 'ObjectName))
(equal nm (vlax-get x 'Name))
)
(progn
(setq ang (vlax-get x 'Rotation))
;; assume uniform scaling
(setq scl (vlax-get x 'XScaleFactor))
(setq modvec (ScalePt vec '(0.0 0.0 0.0) scl))
(setq modvec (RotatePt modvec '(0.0 0.0 0.0) ang))
(vlax-invoke x 'Move modvec '(0.0 0.0 0.0))
)
)
) ;for
(vla-regen doc acActiveViewport)
(princ)
) ;end

 

Hi James,

I looked at what you posted here. I haven't tried running it yet. Obviously there's
lot to digest in terms of what's going on.

One question for now. Did you develop all the MWE (I assume your company name)
functions on your own? Nothing implied. I'm just curious.

Regards
Joe Burke

 

Joe, I tried this and it seems to work well. However, on a large drawing it
could take a long time to complete due to this:

(vlax-for x mspace
(if
(and
(equal "AcDbBlockReference" (vlax-get x 'ObjectName))
(equal nm (vlax-get x 'Name))
)
.....blah
)

A filtered selection set would be MUCH faster and has the benefit of
modifying ALL inserted occurances, regardles of what space they are in.

Code:

;; JB 10/5/2004 revised version 2
;; function: move a block's insertion point
;; designed for model space blocks
;; modified 10/5/2004 by Jeff Mishler to accomodate All insertions,
;; regardless of space, and to only iterate a Selection Set.
(defun c:MBi (/ doc blocks mspace blkref oldpt newpt
blkdef nm refscl refang vec ang scl modvec RotatePt ScalePt ss)

(defun RotatePt (pt bp ang)
(polar bp (+ (angle bp pt) ang) (distance bp pt))
) ;end

(defun ScalePt (pt bp scale / vec scl)
(setq vec (mapcar '- pt bp))
(setq scl (mapcar '(lambda (x) (* x scale)) vec))
(mapcar '+ scl bp)
) ;end

(setq doc (vla-get-activedocument (vlax-get-acad-object))
blocks (vla-get-blocks doc)
mspace (vla-get-ModelSpace 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 selected. ")
)

(setq nm (vlax-get blkref 'Name))
(setq blkdef (vla-item blocks nm))
;; assume uniform scaling
(setq refscl (vlax-get blkref 'XScaleFactor))
(setq refang (vlax-get blkref 'Rotation))
(setq oldpt (vlax-get blkref 'InsertionPoint))
(setq newpt (trans (getpoint "\nSelect new insertion point: ") 1 0))
(setq oldpt (ScalePt oldpt newpt (/ 1.0 refscl)))
(setq oldpt (RotatePt oldpt newpt (- refang)))
(setq 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)
)

;get selection set of blocks, added by JMM
(setq ss (active_ss_all (list '(0 . "INSERT") (cons 2 nm))))

;; move block references
(vlax-for x ss ;changed mspace to ss
;;;    (if
;;;      (and
;;;        (equal "AcDbBlockReference" (vlax-get x 'ObjectName))
;;;        (equal nm (vlax-get x 'Name))
;;;      )
;;;      (progn
(setq ang (vlax-get x 'Rotation))
;; assume uniform scaling
(setq scl (vlax-get x 'XScaleFactor))
(setq modvec (ScalePt vec '(0.0 0.0 0.0) scl))
(setq modvec (RotatePt modvec '(0.0 0.0 0.0) ang))
(vlax-invoke x 'Move modvec '(0.0 0.0 0.0))
(vla-update x);added JMM
;;;      )
;;;    )
) ;for
;(vla-regen doc acActiveViewport);commented JMM
(princ)
) ;end

And the Active_ss_all routine I use to get an ActiveX slection set:

Code:

;;Selection set routine that allows filters that follow the standard (ssget)
filter rules.
;;by Jeff Mishler, December 2003
(defun active_ss_all (flist / code val ss)
(or *doc* (setq *doc* (vla-get-activedocument (vlax-get-acad-object))))
(vl-catch-all-apply 'vla-add
(list (vla-get-selectionsets *doc*) "activex_ss"))
(setq ss (vla-item (vla-get-selectionsets *doc*) "activex_ss"))
(vla-clear ss)
(if flist
(progn
(mapcar '(lambda (a)
(setq code (cons (car a) code))
(setq val (cons (cdr a) val))
)
flist
)
(setq code (vlax-safearray-fill
(vlax-make-safearray
vlax-vbinteger
(cons 0 (- (length code) 1))
)
code
)
val  (vlax-safearray-fill
(vlax-make-safearray
vlax-vbvariant
(cons 0 (- (length val) 1))
)
val
)
)
(vlax-invoke-method ss 'select acSelectionSetAll nil nil code val)
)
(vla-select ss acSelectionSetAll )
)
(vla-highlight ss :vlax-true)
(if (> (vla-get-count ss) 0)
ss
nil
)
)

 

Hi Joe.

Yes, MWE = company initials.

Did I develop them all? Yes. On my own? That I am more hesitant to claim.
But except for the matrix transpose line that I first noticed in your post
in the other thread, yes. And that line is a jewel IMHO

I am "self taught", but have had much help along the way, including much
from this newsgroup since I discovered it about two years ago. What I
posted I developed/wrote with no direct reference to other's code, except as
already noted. But I have no illusions that it is entirely unique either.

No implication taken.

James

 

Thanks, Jeff. Both for checking it does what it should, and the selection set
modification.

I'm on my way out so no time reply in detail. Just one question, have you run any
speed tests with a large drawing to compare the filtered selection method vs.
stepping through the model space collection? I haven't, but I will later today. You
know... sometimes what you assume is true and what's actually the case, are two
different things.

Thanks again
Joe Burke

 

Joe, I tested and it worked fine here as well. Unless of course there are
any nested in other blocks...<grin> I'm pretty sure that's not an issue for
most people, but I have to deal with it here.

Minor questions (I think) :
1. Are there particular times when one should use
(vlax-get obj '<prop>) over
(vla-get-<prop> obj)?
Or is that just a style preference?
2. Likewise with
"(vlax-property-available-p blkref 'Path) ;exclude xrefs" over
"(vla-get-isxref blkref) ;exclude xrefs".

James

 

Joe, I just ran a test on a drawing 1.6mb in size that contains 9039
entites, modelspace and all layouts combined. I had to modify both routines
to add (timein) & (timeout "MBI") as well as move the "New insertion point"
selection to right after the block selection. So the beginning looks like
this in both of our routines:
(princ "\nMissed pick or wrong object type selected. ")
)
(setq newpt (trans (getpoint "\nSelect new insertion point: ") 1 0))
(timein)
(setq nm (vlax-get blkref 'Name))
This way only the actual time is measured when there is no human
interaction.
The (timeout) I placed right at the end, before the final (princ)

Here's the results, using the same block both times. This block has been
inserted 8 times in MS and once in PS. All of them are updated with mine,
only the MS inserts are updated with yours.

Command: mbi

Select block:
Select new insertion point: _cen of
Command:
MBI-jmm ran in an Elapsed Time of: 0.11 seconds

Command:
Command: MoveBlockIP

Select block:
Select new insertion point: _cen of Regenerating model.

Command:
MBI-JB ran in an Elapsed Time of: 2.28 seconds

Command:

Here are the 2 small routines I used for checking the time:
(defun timein ()
(setq start-time (getvar "tdindwg"))
)
(defun timeout (cname / secs)
(setq secs (* (- (getvar "tdindwg") start-time) 86400))
(princ (strcat "\n" cname " ran in an Elapsed Time of: " (rtos secs 2 2) "
seconds"))
(princ)
)

 

RE: "Joe's MoveBlockIP moved the IP, but not to the picked location".

Yes, sorry. I got confused testing the 3 routines - when James' routine placed a sample block I think I mentally ticked that step, forgetting that it applied to your routine.

Works nicely, thanks!

 

I added that line, and the line

(vla-delete obj1)

before the regen line. I don't know autolisp, I just took a guess, but it seems to work fine - neither sample block was left. Thanks.

 

thanks for all of you.
now, i design a lisp by your help. share
;| c:chbkins = redefine block's insertpoint and keep the block reference place------------ok!!----lxx.2004.10
|;
(defun c:chbkins ( / *doc e p000 p1e p1 p2 p2x bkobj ss lst)
(while (not(and (princ "\nselect a blockref:")
(setq s (ssget ":S:E" '((0 . "INSERT"))))
)))
(setq *doc (vla-get-activedocument(vlax-get-acad-object))
p000 (list 0. 0. 0.)
e (ssname s 0)
bkn (xdxf e 2) ;;blockname
p1e (xdxf e 10) ;;insertpoint of wcs.
p1 (trans p1e e 1)
p2 (getpoint p1 "\nselect new insert point:"))
(if p2
(progn
(setq p2x (x-inspttrans e (trans p2 1 0)) ;new insertpoint of wcs.
bkobj (vla-item (vla-get-blocks *doc) bkn) ;;get the objs in the block define.
ss (ssget "x" (list '(0 . "INSERT") (cons 2 (xdxf e 2))))
)
;;redefine insertpoint
(vlax-for i bkobj (setq lst (cons i lst)))
(mapcar '(lambda (x) (vla-move x (ptx p2x) (ptx p000))) lst);;ok!
;;move bak to old place
(mapcar '(lambda (x)(vla-move(x2o x)(ptx (xdxf x 10))(ptx (x-insptbak x p2x))))(xss2lst ss))
)
)
(princ)
)
;;********************************************************************************
;;(x-inspttrans e pt) = get the new insertpoint in a block define-----ok!
(defun x-inspttrans (e pt / obj atts attv p ang xs ys zs ) ;;for wcs
(setq p000 (list 0. 0. 0.)
obj (vlax-ename->vla-object e)
p (xdxf e 10)
atts '(rotation xscalefactor yscalefactor zscalefactor)
attv (mapcar '(lambda(x)(vlax-get obj x)) atts))
(mapcar 'set '(ang xs ys zs) attv)
(setq pt (polar p000 (- (angle p pt) ang) (distance p pt))
pt (mapcar '/ pt (list xs ys zs)))
)
;;********************************************************************************
;;get the orignal insertpoint by pt wcs.------------------ok!
(defun x-insptbak (e pt / obj atts attv p ang xs ys zs) ;;for wcs
(setq p000 (list 0. 0. 0.)
p (xdxf e 10)
obj (vlax-ename->vla-object e)
atts '(rotation xscalefactor yscalefactor zscalefactor)
attv (mapcar '(lambda(x)(vlax-get obj x)) atts))
(mapcar 'set '(ang xs ys zs) attv)
(setq pt (mapcar '* pt (list xs ys zs))
pt (polar p (+ (angle p000 pt) ang) (distance p000 pt)))
)
;; trans point to vla point
(defun ptx (pt)
(if (= (type pt) 'variant)
pt
(vlax-3d-point pt)
)
)
;; get the dxf value
(defun xdxf (e id)
(cdr(assoc id (entget e)))
)
;;(xss2lst ss) = get the list of enames in the ssget
(defun xss2lst (ss / i lst)
(setq i -1)
(while (setq e (ssname ss (setq i (1+ i))))
(setq lst (cons (xdxf e -1) lst))
)(reverse lst)
)

 

Oh.

So you mean I can use
(vlax-get obj 'insertionpoint)
instead of
(vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint obj)))

That's very nice.

I was confused about the xref thing, but that makes sense now. I *thought*
that the line I proposed was a one-for-one replacement, but I see now that
it DEFINITELY was not. I know about vlax-dump-object, but have exclusively
used the help reference for properties and methods; and help doesn't mention
that 'path is a blockREF property. Maybe I should start dumping objects
more if I really want to know.

Thank you Luis

James

 

I guess I figured there would be no need to *add* an old block, as there
must already be some present if you have a need for this. But by design
adding a new sample block was required, so automatically cleaning it up
afterwards seems reasonable. If it is positioned over an already existing
old block though, you wouldn't want to get rid of the old sample block.

James