Ayuda para poder programar autocad desde fwh

Post Reply
cybergrates
Posts: 6
Joined: Mon Nov 13, 2006 11:11 pm
Contact:

Ayuda para poder programar autocad desde fwh

Post by cybergrates »

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 Sanchez (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
Post Reply