[编程申请]：使块体内实体变为0层

hxg2959

是针对一些不能改变颜色的块。

cooltl18

nentsel

eachy

2. 
   
3. Sub tt()
   
4. For Each entry In ThisDrawing.Blocks
   
5.     If (Not entry.IsLayout) And (Not entry.IsXRef) Then
   
6.         For Each ent In entry
   
7.             ent.Layer = "0"
   
8.             ent.color = acByBlock
   
9.         Next
   
10.     End If
    
11. Next
    
12. ThisDrawing.Regen acAllViewports
    
13. End Sub
    

<br /> Sub tt()<br /> For Each entry In ThisDrawing.Blocks<br />     If (Not entry.IsLayout) And (Not entry.IsXRef) Then<br />         For Each ent In entry<br />             ent.Layer = "0"<br />             ent.color = acByBlock<br />         Next<br />     End If<br /> Next<br /> ThisDrawing.Regen acAllViewports<br /> End Sub<br />

移动硬盘

能说得具体点吗

xshrimp

[php]
;图块定义至0层.可以包括多重块,无名块.重新定义至0层.解决块不随层显示的问题.
(defun c:blkfix( /  b bn doc e el tl x)
;;; a list of all block names
;;; return example ("*D5" "A$C263E5435" "b2" "b1")
(defun ax:blocks (/ b bn tl)
  (vlax-for b (vla-get-blocks
                (vla-get-ActiveDocument (vlax-get-acad-object))
              )
    (if (= (vla-get-islayout b) :vlax-false)
      (setq tl (cons (vla-get-name b) tl))
    )
  )
  (reverse tl)
)

(defun bredef (b / e el)
    (setq e (tblobjname "BLOCK" b))
    (while e
      (setq el (entget e))
      (setq el (subst '(8 . "0") (assoc 8 el) el))
          (setq el (if (assoc 62 el)
                   (subst '(62 . 256) (assoc 62 el) el)
                   (append el '((62 . 256)))
                   );end if
                );end setq
      (entmake el)
      (setq e (entnext e))
    )
    (if (/= "ENDBLK" (cdr (assoc 0 el))) (entmake '((0 . "ENDBLK") (8 . "0") (62 . 256))))
  )

(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(mapcar  '(lambda (x) (bredef x)) (ax:blocks))
(command "regen")
)
[/php]

KENSHIN709

这个程序非常之好,我想找了好久了.终于有高人(  xshrimp )写出来了!!
在这里我想提一提意见,使这个程序更加完善!!
1.增加框选功能来选择所要修改的块.
2.在修改有文字的属性快时,文字也要by color
如果这2点修改后,这个程序会更好用哦.
xshrimp 老大是造福全人类啊.
强烈要求版主加分给 xshrimp !!!!!!!!