Fica aqui disponível para copy /past directamente para o editor.
As rotinas têm as diferenças entre o Autocad e cada um dos outros programas marcadas a vermelho.
Para Autocad:
Public Sub layer()
Dim novalayer As String
Dim objlayer As AcadLayer
novalayer = InputBox("Nome da Nova Layer ?")
If "" = novalayer Then
Exit Sub
End If
On Error Resume Next
Set objlayer = ThisDrawing.Layers(novalayer)
If objlayer Is Nothing Then
Set objlayer = ThisDrawing.Layers.Add(novalayer)
If objlayer Is Nothing Then
MsgBox "Não é possivel criar a layer '" & novalayer & "'"
Else
MsgBox "Layer Nova Criada '" & objlayer.Name & "'"
End If
Else
MsgBox "O Layer Já Existe"
End If
Set NovaCor = New AcadAcCmColor
NovaCor.ColorMethod = acColorMethodByRGB
ncolor = CLng(InputBox(vbCr & "Qual o número da cor para o layer: ", "Layer Color", "10"))
If ncolor < 0 Or ncolor > 256 Then
MsgBox "Use o número da cor entre o 0 e o 256"
End If
NovaCor.ColorIndex = ncolor
objlayer.TrueColor = NovaCor
'coloca a nova layer como current
ThisDrawing.ActiveLayer = objlayer
End Sub
Para GstarCad:
Public Sub layer()
Dim novalayer As String
Dim objlayer As GcadLayer
novalayer = InputBox("Nome da Nova Layer ?")
If "" = novalayer Then
Exit Sub
End If
On Error Resume Next
Set objlayer = thisDrawing.Layers(novalayer)
If objlayer Is Nothing Then
Set objlayer = thisDrawing.Layers.Add(novalayer)
If objlayer Is Nothing Then
MsgBox "Não é possivel criar a layer '" & novalayer & "'"
Else
MsgBox "Layer Nova Criada '" & objlayer.Name & "'"
End If
Else
MsgBox "O Layer Já Existe"
End If
Set NovaCor = New GcadAcCmColor
NovaCor.ColorMethod = acColorMethodByRGB
ncolor = CLng(InputBox(vbCr & "Qual o número da cor para o layer: ", "Layer Color", "10"))
If ncolor < 0 Or ncolor > 256 Then
MsgBox "Use o número da cor entre o 0 e o 256"
End If
NovaCor.ColorIndex = ncolor
objlayer.TrueColor = NovaCor
'coloca a nova layer como current
thisDrawing.ActiveLayer = objlayer
End Sub
Para ZwCad:
Public Sub layer()
Dim novalayer As String
Dim objlayer As ZwcadLayer
novalayer = InputBox("Nome da Nova Layer ?")
If "" = novalayer Then
Exit Sub
End If
On Error Resume Next
Set objlayer = ThisDocument.Layers(novalayer)
If objlayer Is Nothing Then
Set objlayer = ThisDocument.Layers.Add(novalayer)
If objlayer Is Nothing Then
MsgBox "Não é possivel criar a layer '" & novalayer & "'"
Else
MsgBox "Layer Nova Criada '" & objlayer.Name & "'"
End If
Else
MsgBox "O Layer Já Existe"
End If
Set NovaCor = New ZwcadAcCmColor
NovaCor.ColorMethod = acColorMethodByRGB
ncolor = CLng(InputBox(vbCr & "Qual o número da cor para o layer: ", "Layer Color", "10"))
If ncolor < 0 Or ncolor > 256 Then
MsgBox "Use o número da cor entre o 0 e o 256"
End If
NovaCor.ColorIndex = ncolor
objlayer.TrueColor = NovaCor
'coloca a nova layer como current
ThisDocument.ActiveLayer = objlayer
End Sub
Dim novalayer As String
Dim objlayer As ZwcadLayer
novalayer = InputBox("Nome da Nova Layer ?")
If "" = novalayer Then
Exit Sub
End If
On Error Resume Next
Set objlayer = ThisDocument.Layers(novalayer)
If objlayer Is Nothing Then
Set objlayer = ThisDocument.Layers.Add(novalayer)
If objlayer Is Nothing Then
MsgBox "Não é possivel criar a layer '" & novalayer & "'"
Else
MsgBox "Layer Nova Criada '" & objlayer.Name & "'"
End If
Else
MsgBox "O Layer Já Existe"
End If
Set NovaCor = New ZwcadAcCmColor
NovaCor.ColorMethod = acColorMethodByRGB
ncolor = CLng(InputBox(vbCr & "Qual o número da cor para o layer: ", "Layer Color", "10"))
If ncolor < 0 Or ncolor > 256 Then
MsgBox "Use o número da cor entre o 0 e o 256"
End If
NovaCor.ColorIndex = ncolor
objlayer.TrueColor = NovaCor
'coloca a nova layer como current
ThisDocument.ActiveLayer = objlayer
End Sub
Para BricsCad (igual ao Autocad):
Public Sub layer()
Dim novalayer As String
Dim objlayer As AcadLayer
novalayer = InputBox("Nome da Nova Layer ?")
If "" = novalayer Then
Exit Sub
End If
On Error Resume Next
Set objlayer = ThisDrawing.Layers(novalayer)
If objlayer Is Nothing Then
Set objlayer = ThisDrawing.Layers.Add(novalayer)
If objlayer Is Nothing Then
MsgBox "Não é possivel criar a layer '" & novalayer & "'"
Else
MsgBox "Layer Nova Criada '" & objlayer.Name & "'"
End If
Else
MsgBox "O Layer Já Existe"
End If
Set NovaCor = New AcadAcCmColor
NovaCor.ColorMethod = acColorMethodByRGB
ncolor = CLng(InputBox(vbCr & "Qual o número da cor para o layer: ", "Layer Color", "10"))
If ncolor < 0 Or ncolor > 256 Then
MsgBox "Use o número da cor entre o 0 e o 256"
End If
NovaCor.ColorIndex = ncolor
objlayer.TrueColor = NovaCor
'coloca a nova layer como current
ThisDrawing.ActiveLayer = objlayer
End Sub
Boa programação
Valeuuuuuuu.....
ResponderEliminarCaro Washington Araujo Melo,
EliminarObrigado pela sua visita. Volte sempre.
Cumprimentos.
Francisco, você poderia postar um exemplo onde eu crio uma polyline, após isso crio ma layer com nome e cor definidos e depois disso, faço com que ela seja aplicada a polyline desenhada. Obrigado
ResponderEliminarCaro Izaac Sena,
EliminarAntes de mais, obrigado pela visita.
Pode aproveitar aqui alguns ecemplos e tentar começar a sua própria programação.
Se quiser algo em concreto como está pedindo eu posso dar o preço para esse trabalho.
Cumprimentos.