|
Lucakit
Nuovo Utente
Regione: Piemonte
Prov.: Torino
Cittā: Torino
17 Messaggi |
 Inserito il - 27/10/2010 : 02:19:05
|
Ciao!
Ho ritenuto meglio aprire una nuova discussione perchč credo che questo argomento meriti la giusta evidenza, dato che sul web la documentazione č scarsissima...
Spiego in breve, per chi inizia a leggere la mia storia solo da questa discussione, il mio obiettivo.
Durante la compilazione del mio codice č risultato necessario interagire a mano con le operazioni del codice stesso: a un certo punto della macro avrei bisogno di poter modificare dei dettagli del disegno, in quantitā indefinita e in modo diverso da una volta all'altra (ma senza usare un'eccessiva gamma di comandi...diciamo quelli di base). Infine, dopo queste operazioni "ad-hoc", la macro termina di nuovo in automatico con salvataggi e stampe (quindi torno a non avere il controllo di essa fino alla fine).
Pertanto, dopo tanto sbattere la testa, sono giunto alla soluzione che riporto qua sotto, ad uso di chi si trova nel mio stesso mal di testa!
E' previsto un DO...LOOP UNTIL che comprende una SELECT di tutti i comandi di cui posso aver bisogno; tra i comandi, ho messo quello per cui faccio proseguire la macro di nuovo in maniera autonoma (per me č il SAVE). Il tutto comprende la gestione del tasto ESC, nel caso di errore da parte dell'utente nelle operazioni, e la possibilitā di annullare le ultime operazioni svolte.
NOTA IMPORTANTE: nel mio caso, era fondamentale cambiare le coordinate di alcuni punti perchč io lavoro in un sistema di riferimento diverso dal WCS mentre alcuni comandi lavorano solo in quest'ultimo; pertanto, per chi non č nel mio caso, č necessario eliminare le parti di codice che riportano " - ThisDrawing.ActiveUCS.origin(n)" e "CVar(punto_taldeitali)"!
Difetti da sistemare nel tempo:
- far comparire l'anteprima delle modifiche che stanno per essere fatte (quello che succede con i comandi di autocad nel momento in cui "si prendono le misure" della modifica)
- introdurre il comando per MODIFICARE LA POSIZIONE DEI PUNTI DI UNA SPLINE........LUCIO, QUI MI APPELLO A TE SE HAI UN'IDEA!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!![:(][:(][:(][:(]
- comando "Redo" per ripristinare le azioni annullate erroneamente
- gestione di eventuali altri errori
Do
se_premi_ESC_torna_qua:
Dim chiavi As String
chiavi = "M R S I T E L Z P A V"
ThisDrawing.Utility.initializeuserinput 128, chiavi
On Error GoTo OH_NO
Dim scelta As String
scelta = ""
scelta = ThisDrawing.Utility.GetKeyword("Cosa vuoi fare? (Muovi/Ruota/Scala/Interrompi/Taglia/Elimina/Linea_tratteggiata/Zoom/zoomPrecedente/Annulla/salVa_stampa): ")
Dim Selezione As AcadSelectionSet
Dim EntitāSelezione As AcadEntity
Dim scalefactor As AcadDimAligned
Dim punto As Variant
Dim puntoDA(0 To 2) As Double
Dim puntoA(0 To 2) As Double
Dim entObj As AcadEntity
Dim Pnt As Variant
Dim Pnt2 As Variant
Dim det As String
Dim lspPnt As String
Dim lspPnt1 As String
Dim lspPnt2 As String
Dim puntomed...(0 To 2) As Double
Select Case scelta
Case "M" 'MUOVI (MOVE)
On Error GoTo OH_NO
With ThisDrawing.SelectionSets
While .Count > 0
.Item(0).Delete
Wend
Set Selezione = .Add("$MoveTest$")
End With
Selezione.SelectOnScreen
Set objutil = ThisDrawing.Utility
strPrmt = vbCr & "Muovi DAL punto: "
punto = objutil.GetPoint(Prompt:=strPrmt)
puntoDA(0) = punto(0) - ThisDrawing.ActiveUCS.origin(0): puntoDA(1) = punto(1) - ThisDrawing.ActiveUCS.origin(1): puntoDA(2) = 0
punto1 = CVar(puntoDA)
strPrmt = vbCr & "AL punto: "
objutil.initializeuserinput 33
punto = objutil.GetPoint(punto1, strPrmt)
puntoA(0) = punto(0) - ThisDrawing.ActiveUCS.origin(0): puntoA(1) = punto(1) - ThisDrawing.ActiveUCS.origin(1): puntoA(2) = 0
punto2 = CVar(puntoA)
For Each EntitāSelezione In Selezione
Set objcopy = EntitāSelezione.Copy
objcopy.Move punto1, punto2
Next EntitāSelezione
Selezione.Erase
Set Selezione = Nothing
Set objutil = Nothing
Set objcopy = Nothing
ThisDrawing.Regen (True)
Case "R" 'RUOTA (ROTATE)
On Error GoTo OH_NO
'ThisDrawing.StartUndoMark
With ThisDrawing.SelectionSets
While .Count > 0
.Item(0).Delete
Wend
Set Selezione = .Add("$MoveTest$")
End With
Selezione.SelectOnScreen
Set objutil = ThisDrawing.Utility
strPrmt = vbCr & "Ruota attorno al punto: "
punto = objutil.GetPoint(Prompt:=strPrmt)
puntoB = punto
puntoDA(0) = punto(0) - ThisDrawing.ActiveUCS.origin(0): puntoDA(1) = punto(1) - ThisDrawing.ActiveUCS.origin(1): puntoDA(2) = 0
punto1 = CVar(puntoDA)
strPrmt = vbCr & "Angolo di rotazione: "
objutil.initializeuserinput 33
punto = objutil.GetPoint(punto1, strPrmt)
puntoA(0) = punto(0) - ThisDrawing.ActiveUCS.origin(0): puntoA(1) = punto(1) - ThisDrawing.ActiveUCS.origin(1): puntoA(2) = 0
punto2 = CVar(puntoA)
dblrot = objutil.AngleFromXAxis(punto1, punto2)
For Each EntitāSelezione In Selezione
Set objcopy = EntitāSelezione.Copy
objcopy.Rotate puntoB, dblrot
Next EntitāSelezione
Selezione.Erase
Set Selezione = Nothing
Set objutil = Nothing
Set objcopy = Nothing
ThisDrawing.Regen (True)
'ThisDrawing.EndUndoMark
Case "S" 'SCALA (SCALE)
On Error GoTo OH_NO
With ThisDrawing.SelectionSets
While .Count > 0
.Item(0).Delete
Wend
Set Selezione = .Add("$MoveTest$")
End With
Selezione.SelectOnScreen
Set objutil = ThisDrawing.Utility
strPrmt = vbCr & "Scala: "
punto = objutil.GetPoint(Prompt:=strPrmt)
puntoB = punto
puntoDA(0) = punto(0) - ThisDrawing.ActiveUCS.origin(0): puntoDA(1) = punto(1) - ThisDrawing.ActiveUCS.origin(1): puntoDA(2) = 0
punto1 = CVar(puntoDA)
strPrmt = vbCr & "Scala: "
objutil.initializeuserinput 33
punto = objutil.GetPoint(punto1, strPrmt)
puntoA(0) = punto(0) - ThisDrawing.ActiveUCS.origin(0): puntoA(1) = punto(1) - ThisDrawing.ActiveUCS.origin(1): puntoA(2) = 0
punto2 = CVar(puntoA)
puntomed...(0) = (punto1(0) + punto2(0)) / 2: puntomed...(1) = (punto1(1) + punto2(1)) / 2: puntomed...(2) = 0
text = CVar(puntomed...)
Set scalefactor = ThisDrawing.ModelSpace.AddDimAligned(punto1, punto2, text)
scalefactor.Visible = False
valore = scalefactor.Measurement / 4 'questo denominatore varia la sensibilitā della scala
For Each EntitāSelezione In Selezione
Set objcopy = EntitāSelezione.Copy
objcopy.ScaleEntity puntoB, valore
Next EntitāSelezione
Selezione.Erase
Set Selezione = Nothing
Set objutil = Nothing
Set objcopy = Nothing
ThisDrawing.Regen (True)
Case "I" 'INTERROMPI (BREAK)
On Error GoTo OH_NO
ThisDrawing.Utility.GetEntity entObj, Pnt, "Seleziona il primo PUNTO della linea in cui tagliare: "
Pnt2 = ThisDrawing.Utility.GetPoint(, "Seleziona il secondo PUNTO in cui tagliare: ")
puntoA(0) = Pnt2(0) - ThisDrawing.ActiveUCS.origin(0): puntoA(1) = Pnt2(1) - ThisDrawing.ActiveUCS.origin(1): puntoA(2) = 0
Pnt2 = CVar(puntoA)
det = GetDoubleEntTable(entObj, Pnt)
lspPnt1 = axPoint2lspPoint(Pnt)
lspPnt2 = axPoint2lspPoint(Pnt2)
ThisDrawing.SendCommand "_break" & vbCr & det & vbCr & lspPnt1 & vbCr & lspPnt2 & vbCr
ThisDrawing.Regen (True)
Case "T" 'TAGLIA (BREAK AT POINT)
On Error GoTo OH_NO
ThisDrawing.Utility.GetEntity entObj, Pnt, "Seleziona la LINEA da tagliare: "
Pnt2 = ThisDrawing.Utility.GetPoint(, "Seleziona il PUNTO in cui tagliare: ")
puntoA(0) = Pnt2(0) - ThisDrawing.ActiveUCS.origin(0): puntoA(1) = Pnt2(1) - ThisDrawing.ActiveUCS.origin(1): puntoA(2) = 0
Pnt2 = CVar(puntoA)
det = GetDoubleEntTable(entObj, Pnt)
lspPnt = axPoint2lspPoint(Pnt2)
ThisDrawing.SendCommand "_break" & vbCr & det & vbCr & lspPnt & vbCr & "@" & vbCr 'lspPnt & vbCr
ThisDrawing.Regen (True)
Case "E" 'ELIMINA
On Error GoTo OH_NO
With ThisDrawing.SelectionSets
While .Count > 0
.Item(0).Delete
Wend
Set Selezione = .Add("$MoveTest$")
End With
Selezione.SelectOnScreen
For Each EntitāSelezione In Selezione
EntitāSelezione.Erase
Next EntitāSelezione
Set Selezione = Nothing
ThisDrawing.Regen (True)
Case "L" 'LINEA TRATTEGGIATA
On Error GoTo OH_NO
With ThisDrawing.SelectionSets
While .Count > 0
.Item(0).Delete
Wend
Set Selezione = .Add("$MoveTest$")
End With
Selezione.SelectOnScreen
For Each EntitāSelezione In Selezione
EntitāSelezione.Linetype = "DASHEDX2"
Next EntitāSelezione
Set Selezione = Nothing
ThisDrawing.Regen (True)
Case "Z" 'ZOOM
On Error GoTo OH_NO
Set objutil = ThisDrawing.Utility
strPrmt = vbCr & "Clicca il primo angolo della zona in cui zoomare: "
punto1 = objutil.GetPoint(Prompt:=strPrmt)
strPrmt = vbCr & "Specifica il secondo angolo: "
objutil.initializeuserinput 33
punto2 = objutil.GetPoint(punto1, strPrmt)
ZoomWindow punto1, punto2
Case "P" 'ZOOMPRECEDENTE
On Error GoTo OH_NO 'qua l'errore non serve perchč non c'č modo di dare ESC, essendo repentino il comando
ZoomPrevious
Case "A" 'ANNULLA ULTIMO COMANDO (UNDO)
On Error GoTo OH_NO 'qua l'errore non serve perchč non c'č modo di dare ESC, essendo repentino il comando
ThisDrawing.SendCommand "_undo" & vbCr
ThisDrawing.SendCommand "1" & vbCr
Case "V" 'SALVA_STAMPA
On Error GoTo OH_NO 'qua l'errore non serve perchč non c'č modo di dare ESC, essendo repentino il comando
Exit Do
End Select
Set Selezione = Nothing
Loop Until scelta = "V"
OH_NO:
ThisDrawing.Utility.Prompt vbCrLf & Err.Description & vbCr
Resume se_premi_ESC_torna_qua
Err.Clear
Public Function GetDoubleEntTable(entObj As AcadEntity, Pnt As Variant) As String
Dim entHandle As String
entHandle = entObj.Handle
GetDoubleEntTable = "(list(handent " & Chr(34) & entHandle & Chr(34) & ")(list " & str(Pnt(0)) & str(Pnt(1)) & str(Pnt(2)) & "))"
End Function
'convert Point to LISP format
Public Function axPoint2lspPoint(Pnt As Variant) As String
axPoint2lspPoint = Replace(Pnt(0), ",", ".") & "," & Replace(Pnt(1), ",", ".") & "," & Pnt(2)
End Function
|
Modificato da - Lucakit in Data 27/10/2010 02:23:38
|
|
|
|
Comandi base (MOVE,ROTATE,...) tramite VBA
Inserito il - 11/11/2010 : 21:08:11
