Inserindo DWG´s como Blocos - VBA

[marcio.cartacho]

Olá Marcio,

parece-me que a linha de código:

pathteste = "*W:\matrizes\LINK TEAMWORK & AUTOCAD\CARIMBOS_LINK_AUTOCAD_TEAMWORK\PORTUGUES\INCHES\GE MOTORS\GEMA2_P_INCHES.dwg"

tem um asterisco (*) a mais logo antes do W.

Será disso?

Boa Tarde, Rui Pestana!

Cara, eu costumo usar este asterisco(*) quando vou inserir um bloco explodido "explode", tem funcionado. no caso destes arquivos que não funcionam se eu remover o asterisco(*) muda a mensagem de erro "SELF REFERENCE" na mesma linha do código "Ultima"...
acho que não é o asterisco..., estou fazendo algums testes mas ainda num cheguei em uma conclusão... satisfatória... se puder continuar me ajudando agradeço mesmo, caso eu encontre algo tb volto a lhe mostrar o resultado.

obrigado até o momento.

[marcio.cartacho]

pessoal, estou tendo problemas em utilizar o object.move point1, point2,
vejam o código abaixo:

Public Sub Search_Object_ModelSpace()
Dim ObjectAcadBlocRef As AcadEntity
Dim varpoint1(0 To 2), varpoint2(0 To 2)
varpoint1(0) = 938.3843
varpoint1(1) = 2719.5305
varpoint1(2) = 0#
varpoint2(0) = 1445.7342
varpoint2(1) = 2719.5305
varpoint2(2) = 0#
Set ObjectAcadBlocRef = FindObjAcadBlockRef("AcDbBlockReference", "IEC_P70")

ObjectAcadBlocRef.Move varpoint1, varpoint2 '<- o erro esta localizado aqui.

End Sub


Function FindObjAcadBlockRef(ByRef Object_Name As String, ByRef Value_Object As String) As AcadEntity
Dim Num As Integer
Num = -1
Achou = False
For i = 0 To ThisDrawing.ModelSpace.Count - 1
If ThisDrawing.ModelSpace.Item(i).ObjectName = Object_Name Then
If UCase(ThisDrawing.ModelSpace.Item(i).Name) = Value_Object Then
Num = i
Set FindObjAcadBlockRef = ThisDrawing.ModelSpace.Item(i)
Exit For
End If 'Fecha .Name
End If 'Fecha ObjectName = "AcDbText"
Next i
End Function

sera que alguem pode me ajudar? o erro esta quando eu informo as Varpoint....

[Rui Pestana]

Caro Marcio,

substitua a linha:

Dim varpoint1(0 To 2), varpoint2(0 To 2)

por:

Dim varpoint1(0 To 2) As Double
Dim varpoint2(0 To 2) As Double

Do modo que escreveu as variáveis estavam declaradas como variantes (por omissão). Os métodos da API do AutoCAD muitas vezes rejeitam argumentos que não sejam explicitamente declarados como deviam, mesmo que o seu conteúdo seja correcto. Quando isto acontecer verifique o tipo de argumento necessário e declare-os exactamente como descrito na ajuda.

Já agora permita-me uma sugestão de alteração mais alargada:

Option Explicit

Public Sub Search_Object_ModelSpace()
Dim ObjectAcadBlocRef As AcadEntity
Dim varpoint1(0 To 2) As Double
Dim varpoint2(0 To 2) As Double
varpoint1(0) = 938.3843
varpoint1(1) = 2719.5305
varpoint1(2) = 0#
varpoint2(0) = 1445.7342
varpoint2(1) = 2719.5305
varpoint2(2) = 0#
Dim NomeBloco As String
NomeBloco = "LEGA3-L"
Set ObjectAcadBlocRef = FindObjAcadBlockRef(NomeBloco) ' "IEC_P70")
'verifica se o bloco foi encontrado
If Not ObjectAcadBlocRef Is Nothing Then
ObjectAcadBlocRef.Move varpoint1, varpoint2
Else
MsgBox "Bloco " & NomeBloco & "não encontrado"
End If


End Sub


Function FindObjAcadBlockRef(ByRef BlockName As String) As AcadEntity
Dim i As Integer
Dim oEntity As AcadEntity
Dim MS As AcadModelSpace
Set MS = ThisDrawing.ModelSpace
For i = 0 To MS.Count - 1
Set oEntity = MS.Item(i)
If TypeOf oEntity Is AcadBlockReference Then
If UCase(oEntity.Name) = BlockName Then
Set FindObjAcadBlockRef = oEntity
Exit Function
End If
End If
Next i

Set FindObjAcadBlockRef = Nothing

End Function


Cumprimentos,

[marcio.cartacho]

Boa Tarde pessoal!

estou tentando inserir um dwg como bloco, mas com a opção DRAGMODE para que a sombra do bloco acompanhe o cursor do mouse, quando eu deixo o dragmode = 2 e tento inserir um dwg como bloco manualmente o processo funciona, mas se eu utilizar uma rotina VBA para inserir ai naum consigo visualizar a sombra do objeto amarrado ao cursor...

meu códio:
Sub Iserindo_arranjos_acess()
Dim Insertpoint As Variant
Select Case TXTACESSORIOS.Value
Case ""
Exit Sub
Case Else
On Error Resume Next
Form_Arranjos.Hide
ThisDrawing.SetVariable "dragmode", 2
Insertpoint = ThisDrawing.Utility.GetPoint(, "Click em um Ponto para Inserir a Caixa dos Acessório: ")
If Err Then Exit Sub
SearchDiagramas.Busca_DimStyle ("DIM-MM")
SearchDiagramas.Busca_DimStyle ("DIM-IN")
Select Case ValEstilo
Case "DIM-MM"
VarScale = VarScale * 25.4
End Select
Set ObjArr = ThisDrawing.ModelSpace.InsertBlock _
(Insertpoint, Directory_Path_acess + TXTACESSORIOS.Value, VarScale, VarScale, VarScale, 0)
ZoomExtents
End Select
End Sub

sera que alguem pode me ajudar?
Obrigado.

[ricardo_casarino]

Será que alguém tem a resposta??

Preciso inserir blocos de uma origem conhecida no sistema, mas o nome do bloco será alterado de acordo com a especificação de um LISTBOX.
Sei que existe uma maneira de alterar o endereço vinculado ao PATHFORM, mas não faço a menor idéia de como fazer.

Obrigado

[danterosado]

Caros,

Como definir o rowsource em um combobox utilizando o AutoCAD?

Atenciosamente,
Dante Rosado