lisp request - send hatch to back in all blocks

[chrisdarmanin]

don't know if its simple, but i guess it is... anyone bothers to do it? 

[rlx]

not sure if this works :

 

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/send-hatch-in-block-to-bottom-of-draworder/td-p/7401472

 

 

[Emmanuel Delay]

 

On 1/14/2019 at 12:48 PM, rlx said:

not sure if this works :

 

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/send-hatch-in-block-to-bottom-of-draworder/td-p/7401472

 

 

 

Yes, it works.

 

I made it send every hatch to the back of the draw order (by ignoring the capa9 variable, which was only for 1 specific layer)

 

Like this:

Command HTB

dwg as example, with a block "MyBlock"

(SETQ *Doc* (VLA-GET-ACTIVEDOCUMENT(VLAX-GET-ACAD-OBJECT)))

(DEFUN HatchToBackBlk (blk / od_blk od_ent blkname)
  (SETQ od_ent (TBLOBJNAME "BLOCK" (SETQ blkname (CDR (ASSOC 2 (ENTGET blk))))))
  (WHILE (SETQ od_ent (ENTNEXT od_ent))
    ;; (IF (EQ (CDR (ASSOC 8 (ENTGET od_ent))) capa9)
    (IF T
      (VL-CATCH-ALL-APPLY
        (FUNCTION
          (LAMBDA ()
            (VLA-MOVETOBOTTOM
              (VLA-ADDOBJECT (VLA-GETEXTENSIONDICTIONARY (VLA-ITEM(VLA-GET-BLOCKS *Doc*) blkname)) "ACAD_SORTENTS" "AcDbSortentsTable")
              (VLAX-MAKE-VARIANT (VLAX-SAFEARRAY-FILL (VLAX-MAKE-SAFEARRAY VLAX-VBOBJECT '(0 . 0)) (LIST (VLAX-ENAME->VLA-OBJECT od_ent))))
            )
          )
        )
      )
    )
  )
  (VLA-REGEN *Doc* 1)
)

(defun c:htb  ( / )
  (HatchToBackBlk  (car (entsel "\nSelect block: " )))
)

HatchToBackBlk.dwg

Edited January 16, 2019 by Emmanuel Delay

[Emmanuel Delay]

here is how to perform this for every block in the blocks table, so you don't have to select them 1 by 1

 

(SETQ *Doc* (VLA-GET-ACTIVEDOCUMENT(VLAX-GET-ACAD-OBJECT)))

(DEFUN HatchToBackBlk (blkname / od_ent )
  (SETQ od_ent (TBLOBJNAME "BLOCK"  blkname ))
  (WHILE (SETQ od_ent (ENTNEXT od_ent))
    (IF T
      (VL-CATCH-ALL-APPLY
        (FUNCTION
          (LAMBDA ()
            (VLA-MOVETOBOTTOM
              (VLA-ADDOBJECT (VLA-GETEXTENSIONDICTIONARY (VLA-ITEM(VLA-GET-BLOCKS *Doc*) blkname)) "ACAD_SORTENTS" "AcDbSortentsTable")
              (VLAX-MAKE-VARIANT (VLAX-SAFEARRAY-FILL (VLAX-MAKE-SAFEARRAY VLAX-VBOBJECT '(0 . 0)) (LIST (VLAX-ENAME->VLA-OBJECT od_ent))))
            )
          )
        )
      )
    )
  )
)

(defun blocks_in_table  ( / result)
  (setq result (list))
  (vlax-for block
    (vla-get-blocks
         (vla-get-activedocument (vlax-get-acad-object))
      )
    (if (not (wcmatch (strcase (vla-get-name block) t) "*_space*")) (progn
      (setq result (append result (list (vla-get-name block) )))
    ))
  )
  result
)

(defun c:htb  ( / blkname)
  (foreach blkname (blocks_in_table)
    (HatchToBackBlk  blkname)
  )
  (VLA-REGEN *Doc* 1)
  (princ)
)

[Adju]

Hi Emmanuel,

I tried your routine and it worked just fine.

Do you think it would be difficult to create a slight variation of it ? Instead of hatch it could send wipeouts to the back ?

I took a look at the routine and must admit that i'm not in your league... creating/modifying lisp routines... peoples here are very good. So, i have no clue about what to change in order to do it by myself.

 

I heard or found somewhere... i don't remember...  that when you print something, it print things in order they were ceated. So, when i create a wipeout for a block, i have to move the wipeout away, copy all the elements of the block, erase them and then paste everything back and move the wipeout to it's original place so the wipeout would not be the last element created.

If it's not a big deal, it would be great ! If it's trouble then no problem, i'll continue manually.

Merci !

[halam]

Emmanuel, Great routine!

When i use it on Dynamic block something wierd happens.

I attached the dwg

 

https://youtu.be/rJv5y0w5iIw

 

test.dwg

[3dwannab]

Try this @halam

 

(vl-load-com)

; Tharwat 18th Sept 2013
; https://www.cadtutor.net/forum/topic/46782-deleting-hatch-from-blocks/?do=findComment&comment=396412

; Modified on 2022.12.12 by 3dwannab to send the hatches to the back

;; TO DO: NA


(defun c:BKHatchToBack (/ *error* acDoc blkn cnt ss1 var_cmdecho var_osmode)

  (defun *error* (errmsg)
    (and acDoc (vla-EndUndoMark acDoc))
    (and errmsg
         (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*"))
         (princ (strcat "\n<< Error: " errmsg " >>\n"))
    )
    (setvar 'cmdecho var_cmdecho)
    (setvar 'osmode var_osmode)
  )

  (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc))

  (setq var_cmdecho (getvar "cmdecho"))
  (setq var_osmode (getvar "osmode"))
  (setvar 'cmdecho 0)
  (setvar 'osmode 0)

  (prompt "\nSelect blocks to hatch with solid hatch: ")
  (if (setq ss1 (ssget '((0 . "INSERT"))))
    (progn
      (setq cnt 0)
      (repeat (setq cnt (sslength ss1))
        (setq cnt  (1- cnt)
              blkn (cons (vla-get-effectivename (vlax-ename->vla-object (_dxf -1 (entget (ssname ss1 cnt))))) blkn)
        )
      )
      (setq blkn (_removedup blkn))
      (foreach x blkn
        (command "-bedit" x)
        (command "_.HATCHTOBACK")
        (command "_.bsave")
        (command "_.bclose")
        (redraw)
      )
      (setvar 'cmdecho var_cmdecho)
    )
  )
  (*error* nil)
  (princ)
)

;; removes duplicate element from the list
(defun _removedup (l)
  (if l
    (cons (car l) (_removedup (vl-remove (car l) (cdr l))))
  )
)

;;----------------------------------------------------------------------;;
;; _dxf
;; Finds the association pair, strips 1st element
;; args   - dxfcode elist
;; Example  - (_dxf -1 (entget (ssname (ssget) 0)))
;; Returns  - <Entity name: xxxxxxxxxxx>

(defun _dxf (code elist)
  (cdr (assoc code elist))
)

; (c:BKHatchToBack)