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

Discussion in 'AutoCAD' started by dream0001, Oct 4, 2004.

  1. dream0001

    Joe Burke Guest

    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
     
    Joe Burke, Oct 7, 2004
    #41
    1. Advertisements

  2. dream0001

    Joe Burke Guest

    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
     
    Joe Burke, Oct 7, 2004
    #42
    1. Advertisements

  3. dream0001

    Huw Guest

    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?
     
    Huw, Oct 8, 2004
    #43
  4. dream0001

    Joe Burke Guest

    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
     
    Joe Burke, Oct 8, 2004
    #44
  5. dream0001

    Joe Burke Guest

    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")))
    ;---------------------------------------------------------
     
    Joe Burke, Oct 8, 2004
    #45
  6. dream0001

    Douglas Barr Guest

    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
     
    Douglas Barr, Oct 8, 2004
    #46
  7. dream0001

    Joe Burke Guest

    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
     
    Joe Burke, Oct 8, 2004
    #47
  8. dream0001

    Douglas Barr Guest

    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
     
    Douglas Barr, Oct 8, 2004
    #48
  9. dream0001

    Joe Burke Guest

    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
     
    Joe Burke, Oct 8, 2004
    #49
  10. dream0001

    Douglas Barr Guest

    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)
    )
     
    Douglas Barr, Oct 8, 2004
    #50
  11. dream0001

    Joe Burke Guest

    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
     
    Joe Burke, Oct 8, 2004
    #51
  12. dream0001

    Douglas Barr Guest

    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
     
    Douglas Barr, Oct 8, 2004
    #52
  13. dream0001

    Joe Burke Guest

    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
     
    Joe Burke, Oct 8, 2004
    #53
  14. dream0001

    James Allen Guest

    "...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
     
    James Allen, Oct 8, 2004
    #54
  15. dream0001

    James Allen Guest

    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)
    )
    
     
    James Allen, Oct 11, 2004
    #55
  16. dream0001

    Huw Guest

    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.
     
    Huw, Oct 11, 2004
    #56
  17. dream0001

    Joe Burke Guest

    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
     
    Joe Burke, Oct 11, 2004
    #57
  18. dream0001

    Joe Burke Guest

    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
     
    Joe Burke, Oct 11, 2004
    #58
  19. dream0001

    Joe Burke Guest

    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
     
    Joe Burke, Oct 12, 2004
    #59
  20. 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


    ...
    ....
    ....
     
    Kent Cooper, AIA, Oct 12, 2004
    #60
    1. Advertisements

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.