Autore |
Discussione |
|
piratabobo
Utente Normale
69 Messaggi |
Inserito il - 26/11/2008 : 11:43:20
|
salve a tutti e da un pò di tempo che sono assente dal forum, ora ho ripreso a riprogrammare in VBA per autocad e mi sono trovato di fronte a un problema che non riesco a risolvere, su un disegno ho disegnato diversi rettangoli come polilinea, adesso selezionandoli vorrei sapere tramite codice le coordinate dei vertici di ogni rettangolo. Quello che vorrei fare e possibile tramite VBA o no? E se e possibile come posso fare, sarei grato per qualunque suggerimento. Ringraziando in anticipo saluto in particolare Ghirardo. Ciao
|
|
admin
Amministratore
Regione: Veneto
Prov.: TV
Città: Treviso
188 Messaggi |
Inserito il - 26/11/2008 : 21:01:40
|
Ciao e ben tornato, prova a guardare questo esempio che ho trovato sull'help di autocad 2006.
Così in fretta mi sembra di aver capito che ti fa selezionare una polilinea col mouse e ti restituisce i vari vertici.
' The following code prompts you to select a lightweight ' polyline, then displays the width of each segment of the ' selected polyline. Dim returnObj As AcadObject Dim basePnt As Variant Dim retCoord As Variant Dim StartWidth As Double Dim EndWidth As Double Dim i, j As Long Dim nbr_of_segments As Long Dim nbr_of_vertices As Long Dim segment As Long Dim message_string On Error Resume Next ThisDrawing.Utility.GetEntity returnObj, basePnt, "Select a polyline" ' Make sure the user selected a polyline. If Err <> 0 Then If returnObj.EntityName <> "AcDbPolyline" Then MsgBox "You did not select a polyline" End If Exit Sub End If ' Obtain the coordinates of each vertex of the selected polyline. ' The coordinates are returned in an array of points. retCoord = returnObj.Coordinates segment = 0 i = LBound(retCoord) ' Start index of coordinates array j = UBound(retCoord) ' End index of coordinates array nbr_of_vertices = ((j - i) \ 2) + 1 ' Number of vertices in the polyline ' Determine the number of segments in the polyline. ' A closed polyline has as many segments as it has vertices. ' An open polyline has one fewer segment than it has vertices. ' Check the Closed property to determine if the polyline is closed. If returnObj.Closed Then nbr_of_segments = nbr_of_vertices Else nbr_of_segments = nbr_of_vertices - 1 End If ' Get the width of each segment of the polyline Do While nbr_of_segments > 0 ' Get the width of the current segment returnObj.GetWidth segment, StartWidth, EndWidth message_string = "The segment that begins at " & retCoord(i) & "," & retCoord(i + 1) _ & " has a start width of " & StartWidth & " and an end width of " & EndWidth MsgBox message_string, , "GetWidth Example" ' Prepare to obtain width of next segment, if any i = i + 2 segment = segment + 1 nbr_of_segments = nbr_of_segments - 1 Loop
|
|
|
piratabobo
Utente Normale
69 Messaggi |
Inserito il - 27/11/2008 : 09:10:07
|
in effetti l'esempio da te riportato andrebbe bene, solo che qualcosa mi sfugge, in quanto se faccio andare la procedura in debug e quindi passo/passo tutto ok, ma se lancio la procedura non mi permette di selezionare la polilinea, oltre a questo problema io vorrei in teoria poter selezionare diverse polilinee e poi ottenere il medesimo risultato in cascata ossia tutti i vertici di ogni polilinea magari distinguendo l'handle di ogni polilinea. Tu pensi che questo sia possibile? |
|
|
piratabobo
Utente Normale
69 Messaggi |
Inserito il - 28/11/2008 : 17:32:58
|
anche perchè con questa procedura tu riesci a selezionare una polilinea per volta, mentre io voglio selezionare diverse polilinee contemporaneamente e ottenere i vertici di ogni singola polilinea. |
|
|
admin
Amministratore
Regione: Veneto
Prov.: TV
Città: Treviso
188 Messaggi |
Inserito il - 28/11/2008 : 18:56:19
|
La risposta veloce è: "Abbi fede"!! |
|
|
admin
Amministratore
Regione: Veneto
Prov.: TV
Città: Treviso
188 Messaggi |
Inserito il - 01/12/2008 : 21:18:38
|
Ciao, prova con questa ma dovrai ad adattarla alle tue esigenze.
' The following code prompts you to select a lightweight ' polyline, then displays the width of each segment of the ' selected polyline.
Dim ent As AcadObject Dim basePnt As Variant Dim retCoord As Variant Dim StartWidth As Double Dim EndWidth As Double Dim i, j As Long Dim nbr_of_segments As Long Dim nbr_of_vertices As Long Dim segment As Long Dim message_string
On Error GoTo ErrorHandler ' Attiva la routine di gestione degli errori.
Unload Me ' Creo un gruppo di selezione Dim ssetObj As AcadSelectionSet Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")
' Aggiungo sl gruppo di oggetti "ssetObj" gli oggetti selezionati col mouse ssetObj.SelectOnScreen
For Each ent In ssetObj ' Make sure the user selected a polyline. If Err <> 0 Then If ent.EntityName <> "AcDbPolyline" Then MsgBox "You did not select a polyline" End If ThisDrawing.SelectionSets.Item("SSET").Delete Exit Sub End If ' Obtain the coordinates of each vertex of the selected polyline. ' The coordinates are returned in an array of points. retCoord = ent.Coordinates
segment = 0 i = LBound(retCoord) ' Start index of coordinates array j = UBound(retCoord) ' End index of coordinates array nbr_of_vertices = ((j - i) \ 2) + 1 ' Number of vertices in the polyline ' Determine the number of segments in the polyline. ' A closed polyline has as many segments as it has vertices. ' An open polyline has one fewer segment than it has vertices. ' Check the Closed property to determine if the polyline is closed. If ent.Closed Then nbr_of_segments = nbr_of_vertices Else nbr_of_segments = nbr_of_vertices - 1 End If ' Get the width of each segment of the polyline Do While nbr_of_segments > 0 ' Get the width of the current segment ent.GetWidth segment, StartWidth, EndWidth message_string = "The segment that begins at " & retCoord(i) & "," & retCoord(i + 1) _ & " has a start width of " & StartWidth & " and an end width of " & EndWidth MsgBox message_string, , "GetWidth Example" ' Prepare to obtain width of next segment, if any i = i + 2 segment = segment + 1 nbr_of_segments = nbr_of_segments - 1 Loop
Next ent
ThisDrawing.SelectionSets.Item("SSET").Delete
ErrorHandler: Select Case Err.Number ' Valuta il numero di errore. Case Is <> 0 ThisDrawing.SelectionSets.Item("SSET").Delete Resume Next End Select
|
|
|
|
Discussione |
|