Actualmente uso VBA para autocad pero quisiera que me pudieran orientar para saber como lo puedo hacer desde FWH, el punto es que con la fabulosa clase ADORDD de Don Fernando Mancera (excelente) me abre muchas posibilidades. Debo construir una nueva clase tAcad ? , hay algún curso para apredender a hacer clases ? , donde me puedo documentar o comprar la documentación para lograr mi objetivo lo mas pronto posible , alguien ya ha incursionado en este ambiente (FWH -VBA) que pueda compartir ejemplos o asesoria ?.
La clase Toleauto no funciona en oAcad:=TOleAuto():New( "Acad.Application" )
Por favor no me vayan a comentar que lo busque en google..
Por cierto la clase tDwg de Tamayo Daza no me sirve porque esta hecha para sustituir autocad y se necesita inscribirse en Alliance graphics algo... para recompilar la clase.
Estoy anexando un codigo fuente en VBA de ejemplo donde inserto un pie de plano, agrego unos datos desde excel e internamente, hago zoom a una colección de archivos dwg entre otras acciones, como sigue:
ThisDrawing.SaveAs ("drawing1.dwg")
'leemos todo el directorio de archivos dwg
Myfile = Dir("C:\borde1\" + "*.dwg")
xi = 0
Do While Myfile <> ""
array2(xi) = Myfile
xi = xi + 1
Limite = xi
Myfile = Dir
Loop
Myfile = Dir("C:\borde1\" + "*.dwg")
' abro uno por uno los archivos dwg
For xi = 0 To Limite - 1
homax = ""
ThisDrawing.Open ("c:\BORDE1\" + Myfile)
cont = xi
ThisDrawing.SendCommand "-view" & vbCr & "_top" & vbCr
'Do While Left(array2(cont), 10) = Left(Myfile, 10)
'homax = Mid(array2(cont), 13, 2)
'cont = cont + 1
'If Left(homax, 1) = "0" Then homax = Mid(homax, 2, 1)
'Loop
'hoja = Mid(Myfile, 13, 2)
'If Left(hoja, 1) = "0" Then hoja = Mid(hoja, 2, 1)
' insertamos un pie de plano
insertionPnt(0) = 4: insertionPnt(1) = -11: insertionPnt(2) = 0
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "C:\borde1\marco\Marco.dwg", 1, 1, 1, 0)
blockRefObj.Update
' ThisDrawing.ModelSpace.Command.ZoomAll
On Error GoTo 0
' buscamos datos dentro del dwg
foundAttributes = False
For Each elem In ThisDrawing.ModelSpace
strA = elem.EntityName
' MsgBox ("elemento " + strA + " " + elem.Name)
If elem.EntityName = "AcDbBlockReference" Then
If elem.Name = "Marco" Then
' MsgBox ("si entro ")
foundAttributes = True
Array1 = elem.GetAttributes
' Get the attributes
End If
End If
If elem.EntityName = "AcDbText" Then
strA = elem.TextString
If InStr(1, strA, "Pos. :") > 0 Then
posicion = Mid(strA, 6, 4)
End If
End If
'If elem.EntityName = "AcDbText" Then
'foundAttributes = True
'Puntoa = elem.InsertionPoint
'
' strA = elem.TextString
'
' strDwgNo = Left(Myfile, 20)
'MsgBox (Asc(Mid(strA, 3, 1)))
' If Len(strA) > 3 Then
'
' If (InStr(1, strA, "E ") > 0 Or InStr(1, strA, "W ") > 0) And Asc(Mid(strA, 3, 1)) > 47 And Asc(Mid(strA, 3, 1)) < 58 Then
'MsgBox (Str(Len(strA)) + "-" + strA + "-" + Str(Len(Mid(strA, 3, 8))) + "-" + Mid(strA, 3, 8))
'
'estenum = Mid(strA, 3, 8)
Next elem
If foundAttributes = True Then
Unload Me
' busqueda en excel no incluida
'strDwgNo = varArray1(intCount).TextString
strDwgNo = "MX-5000-03-1-2" + Mid(Str(500 + xi), 2)
' fin de busqueda
' For x = 0 To UBound(Array1)
' Array1(x).TextString = Str(x)
' If x = 73 Then Array1(73).TextString = "TODO BIEN y muy bien"
' val(x) = Array1(x).TextString
' Next x
' Unload Me
'Array1(73).TextString = "TODO BIEN y muy bien"
'Array1(73).TextString = strRevno
' Save_Form.Show
' los nume del array estan en el plano numatributosenborde.dwg
'Array1(8).TextString = strDiame + "-" + strDwgNo + "-" + strEspec
'Array1(1).TextString = strArea
'Array1(73).TextString = strEspec
'Array1(7).TextString = strPop
'Array1(6).TextString = strTop
'Array1(4).TextString = strPdis
'Array1(5).TextString = strTdis
'Array1(3).TextString = strPprue
'Array1(10).TextString = strDTI
'Array1(81).TextString = strIso
Array1(9).TextString = strDwgNo + "_" + Mid(posicion, 2) + ".dwg"
'Array1(2).TextString = strDesA
'Array1(74).TextString = strRevno
'Array1(82).TextString = hoja + "-" + homax
Array1(48).TextString = "NUMERO DE ELEMENTO " + posicion
Array1(39).TextString = strDwgNo
'ThisDrawing.Layers.Item("FRAME").LayerOn = False
ThisDrawing.SendCommand "_zoom" & vbCr & "W" & vbCr & "8.1,13.9 " & "6,6" & vbCr
'ThisDrawing.SendCommand "_erase" & vbCr & "8.1,13.9 " & vbCr
ZoomAll
' ThisDrawing.Utility.GetEntity Vobj,insertionPnt2
' guardando archivo actualizado
ThisDrawing.SaveAs ("c:\BORDE1\MARCO\" + strDwgNo + "_" + Mid(posicion, 2) + ".dwg")
'Edit_Form.Show
Else
MsgBox "No title block found."
End If
Unload Me
Myfile = Dir
Next xi
' temporalmente ThisDrawing.Close
End Sub
Private Sub UserForm_Click()
End Sub
'This determines how to set the Excel instance.
'Function IsAppRunning() As Boolean
' Dim objExcel As Excel.Application
' On Error Resume Next
' Set objExcel = GetObject(, "Excel.Application")
' IsAppRunning = (Err.Number = 0)
' Set objExcel = Nothing
' Err.Clear
'End Function
dejé muchas lineas comentadas por (') que no operan en este ejemplo
En otras rutinas he tenido que usar
ShellExecute(oWnd:hWnd, 1,'acad',;
nombre, "/b C:\MISDOC~1\Cc\ta.scr", SW_SHOW)
pero para tener mayor control con autocad he tenido que utilizar al mismo tiempo otros softwares como el winbatch haciendo scripts con muchas complicaciones.
Bueno concretando el problema quisiera:
1.- abrir autocad desde FWH
2.- pasarle comandos ( propios de autocad y tipo VBA) como los arriba indicados
De antemano agratesco todos sus comentarios