[ Home | Discussioni Attive | Discussioni Recenti | Segnalibro | Msg privati | Sondaggi Attivi | Utenti | Download | Cerca | FAQ ]
Nome Utente:
Password:
Salva Password
Password Dimenticata?

 Tutti i Forum
 Autocad
 VBA - Visual Basic per Autocad
 lettura dati disegno

Nota: Devi essere registrato per poter inserire un messaggio.

Larghezza finestra:
Nome Utente:
Password:
Icona Messaggio:              
             
Messaggio:

  * Il codice HTML è ON
* Il Codice Forum è OFF


   Allega file
  Clicca qui per sottoscrivere questa Discussione.
 
    

V I S U A L I Z Z A    D I S C U S S I O N E
piratabobo 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
5   U L T I M E    R I S P O S T E    (in alto le più recenti)
admin 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
admin Inserito il - 28/11/2008 : 18:56:19
La risposta veloce è: "Abbi fede"!!
piratabobo 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.
piratabobo 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?
admin 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

© Torna all'inizio della Pagina
Tradotto Da: Vincenzo Daniele & Luciano Boccellino- www.targatona.it | Distribuito Da: Massimo Farieri - www.superdeejay.net | Powered By: - Snitz Forums 2000 Version 3.4.03

Antidoto.org | Brutto.it | Estela.org | Equiweb.it