以下vba代码可以完成相应功能。最后显示所有图层的实体。没有对话框。
Sub LayerWalk()
Dim objLayer As AcadLayer, objLayer2 As AcadLayer, str1 As String
On Error GoTo ErrHand
For Each objLayer In ThisDrawing.Layers
ThisDrawing.Utility.Prompt "当前显示图层为：" & objLayer.name & vbCrLf
ThisDrawing.ActiveLayer = objLayer
objLayer.LayerOn = True
For Each objLayer2 In ThisDrawing.Layers
If objLayer2.name <> objLayer.name Then
objLayer2.LayerOn = False
End If
Next objLayer2
str1 = ThisDrawing.Utility.GetString(0, "回车显示下一图层")
Next objLayer
ErrHand:
For Each objLayer In ThisDrawing.Layers
objLayer.LayerOn = True
Next objLayer
End Sub
;***********************************************************************
;逐层查看
(defun C:VL(/ nlay)
(cond ((= lla nil)(setq lla (list))
(setq alla (tblnext "LAYER" T))
(whilealla
(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)
)
;***********************************************************************
页:
1
[2]