| V I S U A L I Z Z A D I S C U S S I O N E |
| Max |
Inserito il - 05/05/2007 : 00:46:51
Salve
Sto provando a scrivere codice in VBA ma ho un intoppo:
da VB apro un file e devo inserirvi alcuni blocchi.
quando arrivo al codice seguente:
Public Sub InserisciBlocco(Disegno As AcadDocument, strblockName As String, x As Double, y As Double, z As Double)
'Disegno: nome dwg aperto
'strblockName: nome blocco (file dwg)
,x,y,z: coordinate punto inserimento
On Error GoTo InserisciBlocco_Err
'Dim strblockName As String
Dim objAcad As AcadApplication
Dim objDoc As AcadDocument
Dim objBlockRef As AcadBlockReference
Dim dblXcale As Double
Dim dblYscale As Double
Dim dblRotAngle As Double
Dim Pt1(0 To 2) As Variant
Pt1(0) = x ' PuntoInserimento
Pt1(1) = y
Pt1(0) = z
dblXcale = 1
dblYscale = 1
dblRotAngle = 0
Set objBlockRef = Disegno.ModelSpace.InsertBlock(Pt1, strblockName, dblXcale, dblYscale, 0, dblRotAngle)
objAcad.Update
InserisciBlocco_Err:
MsgBox Err.Number
MsgBox Err.Description
End Sub
Sull'istruzione Set objBlockRef = ....
Ho il codice di errore 5 -> chiamata di routine o argomento non valido.
Non riesco a venirne fuori.
Aiuto!
Grazie!
Max |
| 15 U L T I M E R I S P O S T E (in alto le più recenti) |
| admin |
Inserito il - 05/06/2007 : 17:03:44
Ma come, per inserire un blocco lo fa solo se salvato in 2004? Strano...
Se hai voglia farei una prova, prova ad usare "SendCommand" per inserire i blocchi.
Praticamente è come se digitassi dalla tastiera ogni singola richiesta del CAD
nome del blocco Invio
punto inserimetno invio
e così via.
Ciao! |
| byerry |
Inserito il - 05/06/2007 : 15:09:39
Adesso funziona anche a me. Unico problema è che pretende che i blocchi siano salvati in AutoCad 2004. Mah...[8)]
Per adesso va bene ma dovrò riemdiare a quest'intoppo senò limiterò l'applicazione.[:)] |
| Max |
Inserito il - 01/06/2007 : 17:28:39
Ciao
Non ho avuto questi problemi, o meglio non me li ricordo tutti!
Uso VB6 SP 5.0
ed autocad 2004, o meglio Map 2004.
In vb ho caricato i seguenti riferimenti:
Autocad 2006 Type Library
oltre ai "soliti" di VB.
Ho provato il tuo codice, sostituendo il solo nome del file dwg, e mi funziona alla grande!
|
| byerry |
Inserito il - 01/06/2007 : 13:05:27
Mi da errore di "autoriferimento" [:(!] all'ultima riga di codice.
In effetti il nome del blocco nel'intero codice non compare, compare solamente il nome del file origine del blocco. Evidentemente il codice inserisce l'intero disegno. [?] |
| byerry |
Inserito il - 01/06/2007 : 12:48:19
Ciao max,
l'errore 429 esce sull'istruzione GetObject()
hai idea di che libreria installare per eliminarlo?
Tu che versioni di VB e AutoCad stai utilizzando? magari mi salvo i files CAD nelle tue versioni e riprovo. |
| Max |
Inserito il - 01/06/2007 : 12:33:41
Si, quella funzione l'ho scritta io e mi restituisce una stringa: nel mio lavoro ho tutto in un database mdb: coordinate, file (es. blocco.dwg da associare),layer e colore.
il risultato è dunque una stringa del tipo "c:\....\blocco.dwg".
Mi sembra che il primo ploblema (ripulitura) sia risolto.
In effetti avevo tolto il codice e non le dim .... purtroppo l'ora era tarda.
Per quanto riguarda l'errore 429: su che istruzione esce?
Ciao Max |
| admin |
Inserito il - 01/06/2007 : 11:12:16
quella funzione sicuramente restituisce una stringa e dalla descrizione di MAX ti da tutto il percorso.
Per il resto della funzione dovrei provarla, ma non finchè sono al lavoro.
Caio! |
| byerry |
Inserito il - 01/06/2007 : 09:30:19
Ciao,
ragazzi qualcuno (tipo Max) può spiegarmi che tipo di valore restituisce la funzione inserita nel codice sopra chiamata:
LeggeNomeBlocco(TipoBlocco)
Se ho capito bene questa funzione va inserita nella funzione InsertBlock(), ma non so se deve restituire semplicemente il nome el blocco o il suo percorso o cos'altro... Ho provato a farmi restituire da essa il percorso del file contenente il blocco, ma mi da errore di "autoriferimento".
Ecco il codice che uso:
<inizio codice>
Private Sub Command1_Click()
'Connessione all'applicazione AutoCAD
Dim AcadApp As AcadApplication
Set AcadApp = CreateObject("AutoCAD.Application")
'Apertura del documento su cui operare
Dim AcadDoc As AcadDocument
Set AcadDoc = AcadApp.ActiveDocument
'Creazione oggetto blocco e connessione mediante suo percorso
Dim ObjBlockRef As AcadBlockReference
Dim strBlockname As String
strBlockname = "C:\Documents and Settings\giuseppe\Desktop\Concorde.dwg"
'Creazione nuovo Layer su cui mettere blocco
Set New_Layer = AcadDoc.Layers.Add("Concorde")
AcadDoc.ActiveLayer = New_Layer
'Inserimento blocco
Dim PuntoInserimento(0 To 2) As Double
PuntoInserimento(0) = 0
PuntoInserimento(1) = 0
PuntoInserimento(2) = 0
Set ObjBlockRef = AcadDoc.ModelSpace.InsertBlock(PuntoInserimento, strBlockname, 1#, 1#, 1#, 0)
End Sub
<fine codice>
E mi dice pure che non può creare l'applicazione!
Questo codice è posseduto!!!![xx(]
|
| admin |
Inserito il - 31/05/2007 : 17:30:57
Ciao,
hai detto che usi VB6, allora crea il pacchetto d' installazione di VB6 così viene fatto quello che serve automaticamente.
Ma scommetto che vuoi evitare questa cosa e io ti rispondo, al momento, che non ricordo come si fa...
Forse ho trovato qualcosa, prova con
REGSVR32 MiaDLL o MioOCX con esegui di windows. |
| byerry |
Inserito il - 31/05/2007 : 15:33:55
A quanto pare ho estratto la parte di codice che mi serve, ma ora è sorto un nuovo problemino: compare l'errore 429.
Come posso fare per registrare la libreria che mi serve?
[:(] Help me! |
| byerry |
Inserito il - 31/05/2007 : 11:49:54
Ciao Max,
gentilmente potresti estrapolare dal suddetto codice il giusto necessario per inserire un blocco da un file ad un altro. Io opero in VB6 e AutoCAD 2006, pensi vada bene?
Ti ringrazio in anticipo e spero di essere utile anch'io un giorno (vicino).[;)] |
| Max |
Inserito il - 29/05/2007 : 22:23:37
Ciao
Scrivo queste righe con un bel poco di ritardo .... finito un problema ne inizia sempre un altro!
Grazie all'aiuto di Lucio ho risolto. Di seguito il codice che ho utilizzato sull'evento clik di un pulsante:
Private Sub Cmd_Max_Ok_Click()
On Error GoTo Cmd_Max_Ok_Err
Dim acadApp As AcadApplication ' Connect to the AutoCAD application
Set acadApp = GetObject(, "AutoCAD.Application.16")
If Err Then
Err.Clear
Set acadApp = CreateObject _
("AutoCAD.Application.16")
If Err Then
MsgBox Err.Description
Exit Sub
End If
End If ''' se autocad è aperto bene altrimenti lo apre. nel primo caso .... qualche volta mi esce con un errore!!
Dim acadDoc As AcadDocument ' Connect to the AutoCAD drawing
Set acadDoc = acadApp.ActiveDocument
Dim lineObj As AcadLine, PuntoInserimento(0 To 2) As Double, str_Attributo As String
Dim objBlockRef As AcadBlockReference, strblockName As String, Indice As Integer
Dim New_Layer As AcadLayer, TipoBlocco As String, blockObj As AcadBlock, nometag As String
Dim attributeObj As AcadAttribute, height As Double, mode As Long, prompt As String
Dim insertionPoint(0 To 2) As Double, tag As String, value As String, t As Integer
Dim count As Integer, k As Integer, index As Integer, pippo As String, array1 As Variant
Dim Attibuto_Tag As String, P(0 To 2) As Double, Controllo As String, cambio As Boolean
Filetarget = Leggi_PercorsoDatabase()
Set g_Db = OpenDatabase(Filetarget)
Set MioSet = g_Db.OpenRecordset("Punti", dbOpenSnapshot)
PuntoInserimento(0) = 1: PuntoInserimento(1) = 1: PuntoInserimento(2) = 0
height = 1#: mode = acAttributeModeVerify: prompt = "Attribute Prompt"
insertionPoint(0) = 10#: insertionPoint(1) = 10#: insertionPoint(2) = 0
tag = "Attribute Tag": value = "Massimo"
For k = 1 To 2 'nel mio caso ho due tipi di blocco, con i nome e percorso che ho scritto in un database
Select Case k
Case 1
TipoBlocco = "PuntoParcheggio"
Attibuto_Tag = "NUMEROPARCHEGGIO"
Case 2
TipoBlocco = "PuntoSparo"
Attibuto_Tag = "Punto Avvistamento"
End Select
strblockName = LeggeNomeBlocco(TipoBlocco) ' funzione che va a leggere il nome del blocco ed il persorso
Set New_Layer = acadDoc.Layers.Add(TipoBlocco) ' qui aggiungo un layer per mettere i miei blocchi su layer diversi, e con colore diverso
acadDoc.ActiveLayer = New_Layer
Select Case TipoBlocco ' setto il colore voluto sul layer attivo
Case "PuntoParcheggio"
New_Layer.Color = acGreen
Case "PuntoSparo"
New_Layer.Color = acRed
End Select
criterio = TipoBlocco & " = True"
MioSet.FindFirst criterio
Do While Not MioSet.EOF
If MioSet.NoMatch Then
Exit Do
End If
'' sul mio database ho le coordinate del punto di iserimento ed l'attributo da dare: di seguito li leggo
PuntoInserimento(0) = MioSet("Coord_X"): PuntoInserimento(1) = MioSet("Coord_Y"): PuntoInserimento(2) = 0
str_Attributo = MioSet("Attributo")
Set objBlockRef = acadDoc.ModelSpace.InsertBlock(PuntoInserimento, strblockName, 1#, 1#, 1#, 0) 'inserisco il blocco con l'attributo predefinito
count = acadDoc.ModelSpace.count ' ora inserisco l'attributo giusto: non ho trovato un sistema migliore:
ReDim newObjs(count) As AcadEntity ' "pesco" l'ultima entità inserita (il blocco) e ne modifico l'atttributo.
index = count - 1 ' non ho trovato un sistema migliore ... ma funziona
Set newObjs(index) = acadDoc.ModelSpace.Item(index)
With newObjs(index)
pippo = .Name
If .HasAttributes Then
array1 = .GetAttributes
For t = LBound(array1) To UBound(array1)
If StrComp(array1(t).EntityName, "AcDbAttribute", 1) = 0 Then
nometag = array1(t).TagString ' TAG attributo
If nometag = Attibuto_Tag Then
array1(t).TextString = str_Attributo 'Modifico il Testo attributo
.Update
End If
End If
Next t
End If
End With
MioSet.FindNext criterio ' vado a cercare tutti i blocchi di un tipo
Loop
Attibuto_Tag = "null"
Next k
MioSet.Close: g_Db.Close: Set MioSet = Nothing: Set g_Db = Nothing
acadDoc.SaveAs Leggi_PercorsoFileDwg() ''' salvo il file
acadApp.Visible = True
ZoomAll
MsgBox "Finito"
Cmd_Max_Ok_Exit:
Exit Sub
Cmd_Max_Ok_Err:
MsgBox Err.Number
MsgBox Err.Description
Resume Next
Resume Cmd_Max_Ok_Exit
End Sub
Spero di non aver fatto errori a scrivere le righe di sopra: ho tolto molte righe di codice dal mio caso perchè la mia procedura
disegna anche alcune riche, polilinee ecc.
Un meritatissimo grazie a Lucio.
Saluti Max
|
| byerry |
Inserito il - 29/05/2007 : 12:51:26
Ragazzi nemmeno io riesco ad inserire blocchi mediante VB6. Vi sottopongo il codice che sto utilizzando, preso e modificato da quello di cui sopra. Anche a me segnala l'errore indicato da Max.
<inizio codice>
Sub Command1_Click()
'Connessione ad AutoCAD
On Error GoTo Command1_Click_Error
Dim AcadApp As AcadApplication
Set AcadApp = CreateObject("AutoCAD.Application")
Dim AcadDoc As AcadDocument
Set AcadDoc = AcadApp.Application.Documents.Add
AcadApp.Application.Visible = True
'Inserimento blocco
Dim str_Blocco As String
Dim P(0 To 2) As Double
P(0) = 10: P(1) = 10: P(2) = 0
str_Blocco = "C:\Documents and Settings\giuseppe\Desktop\Concorde.dwg"
Dim objBlockRef As AcadBlockReference
Set objBlockRef = AcadDoc.ModelSpace.insertBlock(P, "str_Blocco", 1#, 1#, 1#, 1)
Command1_Click_Error:
MsgBox Err.Number
MsgBox Err.Description
Resume Next
End Sub
<fine codice>
Help me![:(] |
| Max |
Inserito il - 06/05/2007 : 17:21:12
Ciao
Ti ringrazio per la sollecita risposta.
Ho corretto l'errore sul punto ma ancora non riesco ad evitare errori.
in sostanza parto da vb , apro un form e clikko su un bottone eseguento il seguente codice:
Sub Cmd_1_Click()
On Error GoTo Cmd_1_Click_Error
Dim A2K As AcadApplication
Set A2K = CreateObject("AutoCAD.Application")
Dim ADrawing As AcadDocument
Set ADrawing = A2K.Application.Documents.Add
A2K.Application.Visible = True
Dim str_Blocco As String, P(0 To 2) As Variant
' ora occorre disegnare :' inserisco il blocco "parcheggio"
P(0) = 10: P(1) = 10: P(2) = 0
str_Blocco = "D:\Max\Personale\Caccia\Cartografia\Parcheggio.dwg"
Dim objBlockRef As AcadBlockReference
Dim dblXcale As Double
Dim dblYscale As Double
Dim dblRotAngle As Double
dblXcale = 1
dblYscale = 1
dblRotAngle = 0
Set objBlockRef = ADrawing.ModelSpace.InsertBlock(P, strblockName, 1#, 1#, 1#, 0)
''Err.Number -> -2145386445
''Err.Description -> errore nell'operazione del filer
Set objBlockRef = ThisDrawing.ModelSpace.InsertBlock(P, strblockName, 1#, 1#, 1#, 0)
''Err.Number -> 424
''Err.Description -> necessario oggetto
Cmd_1_Click_Error:
MsgBox Err.Number
MsgBox Err.Description
Resume Next
End Sub
Sotto le istruzioni Set objBlockRef ho riportato gli errori che ottengo.
Penso che il problema stia nel fatto che non eseguo una macro, in questo caso ci riesco, ma è da vb che apro autocad, o meglio Autodesk Map.
Forse qualche riferimento agli oggetti non è corretto.
Non riesco ad uscirne
Grazie Max |
| admin |
Inserito il - 06/05/2007 : 13:42:43
Ciao,
intanto nella riga del Set objBlockRef = .....
dove c'è lo zero devi mettere "1" perchè è riferito ad un valore della scala che non può essere "0"
Questo è un esempio del cad
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt,
'"c:\d\disegni\casa.dwg", 1#, 1#, 1#, 0)
Attento, avevi ripetuto 2 volte il Pt1(0) e ti mancava il Pt1(2).
Se il disegno dove inserisci i/il punto è corrente potresti usare "ThisDrawing" al posto di "Disegno".
Almeno io ho provato ed inserisce il blocco, per il resto verifica te.
Ciao e grazie di avermi scritto. |
|
|
|
|
