Newsgroup: it.comp.lang.visual-basic
Titolo: visual basic in ambiente CAD

Aiuto .
Dovrei passare a delle variabili i valori degli attributi di due 
distinti blocchi posizionati esattamente all inizio e alla fine 
di una linea .
Qualcuno  può aiutarmi ??? 
Il tutto utilizzando visual basic in autocadmap 2005.
Grazie a tutti  
-- 
Postato da Alice Newsgroup: lo usi da web ma con le funzioni del newsreader 
http://newsgroup.alice.it
Gerarchie it, italia, it-alt, tin, it.binari. Unico!

 Grazie a tutti  
Ciao Antonio,
ho provato le funzioni sotto AutoCAD 2004, ma dovrebbero andare 
anche sul Map 2005, vedi se il tutto ti e' utile. occhio ai 
ritorni a capo
ciao
Stefano
[code]
'----------------------------------------------------------------
---------------------------------------------
Sub test()
Dim start_pt() As Double
Dim end_pt() As Double
Dim nome_blocco As String
Dim nome_attributo As String
Dim line As AcadLine
Dim att_start_pt, att_ent_pt As String
 
    nome_blocco = InputBox("inserisci il nome del 
blocco") '"SOP108"
    nome_attributo = InputBox("inserisci il nome 
dell'attributo") '"RIGA2"
 
    Set line = GetLine
    If Not line Is Nothing Then
        start_pt = line.StartPoint
        end_pt = line.EndPoint
        att_start_pt = GetAttVal(nome_blocco, nome_attributo, 
start_pt)
        If IsEmpty(att_start_pt) Then
            MsgBox "nome del blocco o dell'attributo non trovati 
nel punto iniziale della linea", vbExclamation
        End If
        att_ent_pt = GetAttVal(nome_blocco, nome_attributo, 
end_pt)
        If IsEmpty(att_end_pt) Then
            MsgBox "nome del blocco o dell'attributo non trovati 
nel punto finale della linea", vbExclamation
        End If
        MsgBox "att_start_pt: " & att_start_pt & vbCrLf 
& "att_ent_pt: " & att_ent_pt
    End If
    Set line = Nothing
End Sub
'----------------------------------------------------------------
---------------------------------------------
' rende il valore dell'attributo del blocco
Function GetAttVal(blockName As String, attributeName As String, 
pt() As Double) As Variant
Dim fType(0) As Integer
Dim fData(0) As Variant
Dim objArray() As AcadEntity
Dim blkTmp As AcadBlockReference
Dim j As Integer
Dim tol As Double
 
    Set ss = CreateSelectionSet
    fType(0) = 2
    fData(0) = blockName
    ss.SelectAtPoint pt, fType, fData
    If ss.Count = 1 Then
        Set blkTmp = ss.Item(i)
        If blkTmp.HasAttributes Then
            atts = blkTmp.GetAttributes
            For j = LBound(atts) To UBound(atts)
                If LCase(atts(j).TagString) = LCase
(attributeName) Then
                    GetAttVal = atts(j).TextString
                End If
            Next
        End If
    End If
    Set ss = Nothing
    Set blkTmp = Nothing
End Function
'----------------------------------------------------------------
---------------------------------------------
' by 
acadx.com
Function CreateSelectionSet(Optional ssName As String = "sset") 
As AcadSelectionSet
Dim ss As AcadSelectionSet
    On Error Resume Next
    Set ss = ThisDrawing.SelectionSets(ssName)
    If Err Then Set ss = ThisDrawing.SelectionSets.Add(ssName)
    ss.Clear
    Set CreateSelectionSet = ss
End Function
'----------------------------------------------------------------
---------------------------------------------
' rende la linea selezionata
Function GetLine() As AcadLine
Dim ent As AcadEntity
Dim pt As Variant
    ThisDrawing.Utility.GetEntity ent, pt, "seleziona la 
linea..."
    If ent.ObjectName = "AcDbLine" Then
        Set GetLine = ent
    End If
End Function
[/code]


stefano v. ha scritto:

Grazi STEFANO faccio due prove e ti faccio sapere.
