Roy_043 发表于 2022-7-5 17:05:38

Hans if you want to change the block definitions for a selection of block references you should first extract their block names:

; (NestedPutProp "MyBlk" 'entitytransparency "BYBLOCK"); (NestedPutProp "MyBlk" 'color 3)(defun NestedPutProp (nme prop val / blk) (if   (and   (not       (vl-catch-all-error-p          (setq blk         (vl-catch-all-apply             'vla-item             (list               (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))               nme             )         )         )       )   )   (= :vlax-false (vla-get-islayout blk))   (= :vlax-false (vla-get-isxref blk))   )   (vlax-for obj blk (vlax-put obj prop val)) ))(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret) (if ss   (repeat (setq i (sslength ss))   (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))   ) ))(defun C:TRBB ( / doc doneLst ss) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vla-endundomark doc) (vla-startundomark doc) (if (setq ss (ssget '((0 . "INSERT"))))   (foreach obj(KGA_Conv_Pickset_To_ObjectList ss)   (if (not (vl-position (strcase (vla-get-name obj)) doneLst))       (progn         (NestedPutProp (vla-get-name obj) 'entitytransparency "BYBLOCK")         (setq doneLst (cons (strcase (vla-get-name obj))))       )   )   ) ) (vla-endundomark doc) (princ))

halam 发表于 2022-7-5 17:08:41

Thx !! that was what i was assuming...
This piece of code allready saves me a whole bunch of dead work load!
But it is still picking blocks one-by-one..
 
The final touch would be it would work on a sessies of blocks for ssget.
As reference, this tool from Gile that can do allmost all, except for the tranparency.
 
http://gilecad.azurewebsites.net/LISP/Edit_bloc_3.5.zip
 
 

Roy_043 发表于 2022-7-5 17:14:03

Judging from your last comment you have not tested the code in my previous post. If you analyse the code you will notice:
(setq ss (ssget '((0 . "INSERT"))))

halam 发表于 2022-7-5 17:17:29

I did however, just does not work as that way.
Only 1 block is redined. Check the link.

Roy_043 发表于 2022-7-5 17:19:58

OK try this:

; (NestedPutProp "MyBlk" 'entitytransparency "BYBLOCK"); (NestedPutProp "MyBlk" 'color 3)(defun NestedPutProp (nme prop val / blk) (if   (and   (not       (vl-catch-all-error-p         (setq blk         (vl-catch-all-apply             'vla-item             (list               (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))               nme             )         )         )       )   )   (= :vlax-false (vla-get-islayout blk))   (= :vlax-false (vla-get-isxref blk))   )   (vlax-for obj blk (vlax-put obj prop val)) ))(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret) (if ss   (repeat (setq i (sslength ss))   (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))   ) ))(defun C:TRBB ( / doc doneLst ss) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vla-endundomark doc) (vla-startundomark doc) (if (setq ss (ssget '((0 . "INSERT"))))   (foreach obj(KGA_Conv_Pickset_To_ObjectList ss)   (if (not (vl-position (strcase (vla-get-name obj)) doneLst))       (progn         (NestedPutProp (vla-get-name obj) 'entitytransparency "BYBLOCK")         (setq doneLst (cons (strcase (vla-get-name obj)) doneLst))       )   )   ) ) (vla-regen doc acactiveviewport) (vla-endundomark doc) (princ))

halam 发表于 2022-7-5 17:24:26

Great !!!
Many thanks!
页: 1 [2]
查看完整版本: Routine to set transparency &#