Routine to set transparency &#

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:

copy

; (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:

copy

(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:

copy

; (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!

[编程交流] Routine to set transparency &#

发表回复

精选推荐

浏览过的版块