Move Block Wipeouts to bottom

[Steven P]

This is one I was looking at yesterday, sharing here because I am really 12....

 

'WipeBottom' will move the defined entity types to the Bottom or Top draw order in a selected block definition. Define the entity types and move direction in the code. Made up because I wanted to split out the selection part of the examples online and use the 2nd part via LISP without user interface. Via LISP I only wanted it to process a single block at a time - selection set processing can be from the calling LISP. Examples out there mostly from Lee Mac - see his website or the link in the code.

 

But apart from that I really wanted to use the LISP command name.

 

 

(defun c:WIPEBOTTOM ( / MyName MoveType MoveDirection)
;;AcDbTypes: AcDb + .... replace 'movetype' below with these as required 
;;AcDbEntity, AcDbLine, AcDbCircle, AcDbArc, AcDbPolyline, AcDbText, AcDbMText
;;AcDbBlockReference, AcDbPoint, AcDbEllipse, AcDbSpline, AcDbHatch, AcDbTable
;;AcDbRasterImage, AcDbLeader, AcDbRay, AcDbXline, AcDbTrace, AcDbWipeout
;;AcDbDimension, AcDbAlignedDimension, AcDbRadialDimension, AcDbDiametricDimension
;;AcDb3PointAngularDimension, AcDbArcDimension, AcDbOrdinateDimension

;;MoveDirections: vla-movetobottom, vla-movetotop

  (Setq MyName (cdr (assoc 2 (entget (car(entsel "Select Block")))))) ;; block name
  (setq MoveType "AcDbHatch") (setq MoveDirection "vla-MoveToBottom")
  (WIPEBOTTOM MyName MoveType MoveDirection)
  (setq MoveType "AcDbWipeout") (setq MoveDirection "vla-MoveToBottom")
  (WIPEBOTTOM MyName MoveType MoveDirection)
  (setq MoveType "AcDbText") (setq MoveDirection "vla-MoveToTop")
  (WIPEBOTTOM MyName MoveType MoveDirection) ;; MyName: Real Block Name (example "MyBlock"), MoveType "ACDb....", MoveDirection "VLA-MoveTo..."
  (princ)
)
(defun WIPEBOTTOM ( name MoveType MoveDirection / acblk acdoc obj name MoveType)
;;https://www.cadtutor.net/forum/topic/31462-wipeout-inside-blocks-issue/
;;updated to single block selections only refer to link for selection sets
;Lee Mac 17.06.11
  (defun LM:SortentsTable ( space / dict result ) 
    (cond
    ((not
        (vl-catch-all-error-p
          (setq result
            (vl-catch-all-apply 'vla-item
              (list (setq dict (vla-GetExtensionDictionary space)) "ACAD_SORTENTS")
            )
          )
        )
      )
      result
    ) ; end not
    ( (vla-AddObject dict "ACAD_SORTENTS" "AcDbSortentsTable") )
    )
  ) ; end defun

  (setq acdoc (vla-get-activedocument (vlax-get-acad-object))) ;;ACDoc reference
  (setq acblk (vla-get-blocks acdoc)) ;ACBlocks references

  (if name
    (progn
      ((lambda ( / lst )
          (vlax-for obj (vla-item acblk name) ;;name: Block name. For each object in block
            (if (eq MoveType (vla-get-objectname obj)) ;;if object is required type
              (setq lst (cons obj lst)) ;; add to list
            ) ; end if
          ) ; end vlax-for
          (if lst
          (progn
              ( (eval (read MoveDirection)) ;; turn text move direction into command
              (LM:SortentsTable (vla-item acblk name)) ;; Sort objects - make into variable and only process once?
              (vlax-make-variant (vlax-safearray-fill
                (vlax-make-safearray vlax-vbobject (cons 0 (1- (length lst)))) lst
              )) ; end vlax-make-variant
            ) ; end vla-move
            (vla-regen acdoc acallviewports) ;; move to after lambda??
          )) ; end if ; end progn
      )) ; end lambda
    ) ;; end progn
  ) ;; end if name
)

 

Edited 16 hours ago by Steven P

[rlx]

Thanx Steven , for wiping mine... 

[Steven P]

Ahh, was that yours RX? Mega apologies - I thought I had taken Lees from earlier in that thread (For this thread, RLX also had some ace code in the thread I linked to above)

[rlx]

I wasn't talking about the code  

[mhupp]

Hehe reminds me of when I made a shortcut command for one of our customs lisp "Assembly populate".