[求助]大家帮忙看下这个功能能否实现

tth02

凑足5个回复再说。

tth02

以下vba代码可以完成相应功能。最后显示所有图层的实体。没有对话框。

1. Sub LayerWalk()
   
2. Dim objLayer As AcadLayer, objLayer2 As AcadLayer, str1 As String
   
3. On Error GoTo ErrHand
   
4. For Each objLayer In ThisDrawing.Layers
   
5.     ThisDrawing.Utility.Prompt "当前显示图层为：" & objLayer.name & vbCrLf
   
6.     ThisDrawing.ActiveLayer = objLayer
   
7.     objLayer.LayerOn = True
   
8.     For Each objLayer2 In ThisDrawing.Layers
   
9.         If objLayer2.name <> objLayer.name Then
   
10.             objLayer2.LayerOn = False
    
11.         End If
    
12.     Next objLayer2
    
13.     str1 = ThisDrawing.Utility.GetString(0, "回车显示下一图层")
    
14. Next objLayer
    
15. ErrHand:
    
16. For Each objLayer In ThisDrawing.Layers
    
17.     objLayer.LayerOn = True
    
18. Next objLayer
    
19. End Sub
    

Sub LayerWalk()<br /> Dim objLayer As AcadLayer, objLayer2 As AcadLayer, str1 As String<br /> On Error GoTo ErrHand<br /> For Each objLayer In ThisDrawing.Layers<br />     ThisDrawing.Utility.Prompt "当前显示图层为：" & objLayer.name & vbCrLf<br />     ThisDrawing.ActiveLayer = objLayer<br />     objLayer.LayerOn = True<br />     For Each objLayer2 In ThisDrawing.Layers<br />         If objLayer2.name <> objLayer.name Then<br />             objLayer2.LayerOn = False<br />         End If<br />     Next objLayer2<br />     str1 = ThisDrawing.Utility.GetString(0, "回车显示下一图层")<br /> Next objLayer<br /> ErrHand:<br /> For Each objLayer In ThisDrawing.Layers<br />     objLayer.LayerOn = True<br /> Next objLayer<br /> End Sub<br />

linheyuanpcb

;***********************************************************************
;逐层查看
(defun C:VL(/ nlay)
   (cond ((= lla nil)(setq lla (list))
          (setq alla (tblnext "LAYER" T))
          (while  alla
                      (setq lla1(cdr (assoc '2 alla)))
                     (setq lla (cons lla1 lla))
                     (setq alla (tblnext "LAYER"))
          )
          (setq lla (reverse lla))
         )
        (T nil)
  )
(setvar "cmdecho" 0)
   (if (= ilay nil)
       (setq ilay 0)
   )
   (if (= ilay (length lla))
         (setq ilay 0)
   )
   (command "_LAYER" "_S" (nth ilay lla) "_off" "*" "" "_on" "raster" "")
   (setq nlay (strcat "\n当前显示图层是; " (nth ilay lla) " 按确认跳转下一层!"))
   (princ nlay)
   (setq ilay (1+ ilay))
   (setvar "cmdecho" 1)
  (princ)
)
;***********************************************************************