Exemplo:
Access Atribuindo Circulos com Hachuria no CAD
'Tem que carregar a Biblioteca do AutoCad
'No meu caso AutoCad 2007 type Libary
'e Autodesk Map 2007
Dim hatchObj As AcadHatch
Dim patternName As String
Dim PatternType As Long
Dim bAssociativity As Boolean
Dim entiCircle(0 To 0) As AcadEntity
Dim acadApp As AcadApplication
Dim model As AcadModelSpace
Dim entry As AcadLayer
Dim pt1(0 To 2) As Double
Dim i As Long
Dim pergunta As Boolean
pergunta = True
On Error Resume Next
'conecta o cad, nao esqueca de adicionar a referencia ao "autocad type(ou object) lybrary"
Set acadApp = GetObject(, "AutoCAD.Application.17")
If Err.number <> 0 Then
Err.Clear
Set acadApp = GetObject("", "AutoCAD.Application.17")
pergunta = False
End If
'Set acadApp = CreateObject("AutoCAD.Application.17")
'Seta o Model do Cad
If pergunta = True Then
If MsgBox("Deseja abrir um Arquivo Novo?", vbYesNo, "Aviso") = vbYes Then
Dim novo As AcadDocument
Set novo = acadApp.Application.Documents.Add 'Abre novo Arquivo
End If
End If
'Seta o Model do Cad
On Error Resume Next
Set model = acadApp.ActiveDocument.modelSpace 'vai pro modelspace
If Err.number <> 0 Then
MsgBox "A janela do AutoCAD não está ativada!" & vbNewLine & "Comando Cancelado!", vbCritical, "ERRO"
rotuloAguarde.Visible = False
Exit Sub
End If
'Cria o Layer Linha
Set entry = acadApp.ActiveDocument.Layers.Add(nomeLayer)
While Not rs.EOF
eixox = rs(9).value
eixoy = rs(10).value
delimitador() = Split(eixox, ".") 'Para Campo que estiverem no X
eixox = Trim$(delimitador(0))
'Trabalhando com Y
delimitador() = Split(eixoy, ".") 'Para Campo que estiverem no Y
eixoy = Trim$(delimitador(0))
pt1(0) = eixox
pt1(1) = eixoy
' Create the associative Hatch object in model space
Set hatchObj = model.AddHatch(acHatchPatternTypePreDefined, "SOLID", True)
Set entiCircle(0) = model.AddCircle(pt1, raio)
' Append the outerboundary to the hatch object, and display the hatch
hatchObj.AppendOuterLoop (entiCircle)
hatchObj.Evaluate
hatchObj.Layer = nomeLayer
hatchObj.color = cor
entiCircle(0).Layer = nomeLayer
entiCircle(0).color = cor
...
Precisando de ajuda procure também por cracksther pois ele tem mais estrada do que eu no VB, tenho uma apostila ótima de VBA, se quiser te mando
E-mail:
[email protected]
Atenciosamente
Cleyson Cloves do Carmo