vba

savasava

我刚刚在学习 VBA开发CAD。我的工作主要是用CAD处理地图，其中很多工作是把某一层的图形转到另一个层。举例来说 如 在A层中线宽为1，颜色为红的直线需转到B层（如果B层不存在则，新建一个B层），请问用VBA程序如何实现 不胜感激
（我用CAD2000）

thankyou

先建立经过过滤的选择集，然后逐个修改起属性。OK！

savasava

能否具体点给出代码，因我刚刚接触VBA不太了解怎么做

mccad

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

coobo

最近我想用VBA编程，对访问某些文件的用户权限作出判断，若无权限则只能以只读方式打开，不知那位大佬知道怎样通过VBA设置某一打开的文件为只读，或在通过VBA只读方式打开文件时，跳过系统的“只读”选项。谢谢。

mccad