Send hatch in block to bottom of draworder

Send hatch in block to bottom of draworder

Anonymous
Not applicable
2,721 Views
2 Replies
Message 1 of 3

Send hatch in block to bottom of draworder

Anonymous
Not applicable

Hello, as in title, i have a routine that craetes lots of blocks, each with a hatch inside, but when i insert it hachs come to top so i cant see annotations. I found a lisp from LeeMac here

 

http://www.cadtutor.net/forum/archive/index.php/t-60244.html?

 

And I tryed to adapt it to my needs but its failing. I changed the function's name and added a parameter (blk = the block to be "fixed"), "AcDbWipeout" has become "AcDbHatch" and (SSGET "X" '((0 . "INSERT"))) changed to (SSADD blk).

I attach a indented file, more readable... Any help is very welcome! Thanks

 

 

 

;; Lee Mac 17.06.11
(defun BlkToBottom (blk / acblk acdoc acsel name obj processed LM:SortentsTable)
(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
)
( (vla-AddObject dict "ACAD_SORTENTS" "AcDbSortentsTable") )
)
)
(setq acdoc (vla-get-activedocument (vlax-get-acad-object))
acblk (vla-get-blocks acdoc)
)
(if (SSADD blk)
(progn
(vlax-for
block
(setq acsel (vla-get-activeselectionset acdoc))
(if (not (member (setq name (vla-get-name block)) processed))
((lambda ( / lst )
(vlax-for obj
(vla-item acblk name)
(if (eq "AcDbHatch" (vla-get-objectname obj))
(setq lst (cons obj lst))
)
)
(if lst
(vla-movetobottom
(LM:SortentsTable (vla-item acblk name))
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbobject (cons 0 (1- (length lst))))
lst
)
)
)
)
(setq processed (cons name processed))
))
)
)
(vla-delete acsel)
(vla-regen acdoc acallviewports)
)
)
)

0 Likes
Accepted solutions (1)
2,722 Views
2 Replies
Replies (2)
Message 2 of 3

Anonymous
Not applicable

I have found another lisp, now in 

http://www.cadtutor.net/forum/archive/index.php/t-26055.html

It works not finding the hatch in the block but finding all objects in certain layers and send them to bottom in order. As all my hatchs are alone in one layer whis could work. I changed this too to make it to my purposes, worked first time, then failed, and cant figure out why.


;(SETQ capa9 "Manzanero - Hatchs")
;(SETQ *Doc* (VLA-GET-ACTIVEDOCUMENT(VLAX-GET-ACAD-OBJECT)))
(DEFUN HatchToBackBlk (blk / od_blk od_ent)
(SETQ od_ent (TBLOBJNAME "BLOCK" (CDR (ASSOC 2 (ENTGET blk)))))
(WHILE (SETQ od_ent (ENTNEXt od_ent))
(IF (EQ (CDR (ASSOC 8 (ENTGET od_ent))) capa9)
(VL-CATCH-ALL-APPLY
(FUNCTION
(LAMBDA ()
(VLA-MOVETOBOTTOM
(VLA-ADDOBJECT (VLA-GETEXTENSIONDICTIONARY (VLA-ITEM(VLA-GET-BLOCKS *Doc*) (CDR (ASSOC 2 od_blk)))) "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)
)

0 Likes
Message 3 of 3

Anonymous
Not applicable
Accepted solution

NEVERMIND. It was a silly mistake. This works

 

;(SETQ capa9 "Manzanero - Hatchs")
;(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)
(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)
)

0 Likes