vba
我刚刚在学习 VBA开发CAD。我的工作主要是用CAD处理地图，其中很多工作是把某一层的图形转到另一个层。举例来说 如 在A层中线宽为1，颜色为红的直线需转到B层（如果B层不存在则，新建一个B层），请问用VBA程序如何实现 不胜感激（我用CAD2000）
OK！
先建立经过过滤的选择集，然后逐个修改起属性。OK！不懂
能否具体点给出代码，因我刚刚接触VBA不太了解怎么做程序如内，你可以按你自己的意思随意更改过滤器
Private Sub ChangLayer()On Error Resume Next
'建立选择集
Dim SSetObj As AcadSelectionSet
Set SSetObj = CreateSelectionSet
'建立过滤器，你可以通过更改过滤器来过滤出你所要的图元
Dim fType As Variant
Dim fData As Variant
BuildFilter fType, fdate, 0, "*LINE", 8, "A", 62, acRed, 43, "1"
'选择对象
SSetObj.Select acSelectionSetAll, , , fType, fData
If SSetObj.Count = 0 Then Exit Sub
'创建图层
Dim LayerObj As AcadLayer
Set LayerObj = CreateLayer("B")
'遍历每一图元更改图元的图层名称
Dim i As Integer
For i = 0 To SSetObj.Count - 1
SSetObj(i).Layer = LayerObj.Name
Next
Set LayerObj = Nothing
Set SSetObj = Nothing
End Sub
Public Sub BuildFilter(typeArray, dataArray, ParamArray gCodes())
Dim fType() As Integer, fData()
Dim index As Long, i As Long
index = LBound(gCodes) - 1
For i = LBound(gCodes) To UBound(gCodes) Step 2
index = index + 1
ReDim Preserve fType(0 To index)
ReDim Preserve fData(0 To index)
fType(index) = CInt(gCodes(i))
fData(index) = gCodes(i + 1)
Next
typeArray = fType: dataArray = fData
End Sub
Public Function CreateSelectionSet(Optional ssName As String = "ss") As AcadSelectionSet
Dim ss As AcadSelectionSet
On Error Resume Next
Set ss = ThisDrawing.SelectionSets(ssName)
If Err Then Set ss = ThisDrawing.SelectionSets.Add(ssName)
ss.Clear
Set CreateSelectionSet = ss
End Function
Public Function CreateLayer(ssLayerName As String) As AcadLayer
Set CreateLayer = ThisDrawing.Layers(ssLayerName)
If Err Then
Err.Clear
Set CreateLayer = ThisDrawing.Layers.Add(ssLayerName)
End If
End Function
在VBA中跳过CAD的提示，
最近我想用VBA编程，对访问某些文件的用户权限作出判断，若无权限则只能以只读方式打开，不知那位大佬知道怎样通过VBA设置某一打开的文件为只读，或在通过VBA只读方式打开文件时，跳过系统的“只读”选项。谢谢。通过文档事件来过滤掉大部分的命令可能会好一些
页:
[1]