SetProperty Method

Hi,

Ok. Let me explain my project a little. I'm currently working on a project in which I need to read a dwg autocad file that is a city map. I should store some information about any block on the map ( that is a house or building or ... ). So when the user selects a building and right-clicks, I open a form for him to enter the values. The only thing lets me differentiate between the different shapes is the handle that autocad assigns to them and increases one by one, I guess. So I can use it in the database to refer to them later. It means according to any shape in the map, I have a record in the database. So I can get or set the data by having the shape's handle. Its why I can never delete or remove a shape on the map and replace it with another shape even with a same property. Because the handle will be lost. You told me that I can use keys, but there no use. If I delete the shape, the keys will change and I can't refer to them in the future.
I wanna give the user ability to recognize the buildings with a specific property on the map. So when he queries the database with a property ( for example buildings with area greater than 500 ), I fill the shape ( that is probably a polyline) indicating the building. So the user will see all the houses with area greater than 500 having filled with a color like blue. I read all your examples. But as I noticed, you don't change the shape's filltype. Maybe there is no way to do that. So you add another shape with same properties on it and delete the original shape. Isn't it possible not to delete the original shape? I need its handle and I explained why I need it.
If it's not possible, would you please give me a hint to make some shapes on the map look different than others? I need this to be a restorable way so that after displaying it for a while I can restore the shape with its previous appearance.
Thank you so much in advance

Hi,

Please try the following VB6 code:

Option Explicit

Dim LastSelectesObjects As Long
Dim LastSelectedHandles() As Long

Private Sub Form_Load()
    Command1.Caption = "Set Price"
    Command2.Caption = "Show Properties"
    Call cAvax1.StartAvax
    Call cAvax1.SetAvaxProperty(UndoRedoOn_p, False)
    Call CreateTheDrawing
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call cAvax1.EndAvax
End Sub

Private Sub cAvax1_SelectChange(LastSelectedHandle As Long)
    Dim hAll() As Long, aR As Single, bR As Single
    Dim sKey As String, lDelCnt As Long, hDel() As Long
    Dim lMax As Long, iColor() As Integer, iWidth() As Integer
    Dim iStyle() As Integer, iLayer() As Integer
    Dim Elevation3D() As Single, Height3D() As Single
    Dim lCnt As Long, xyz() As Single, h As Long
    Dim xV() As Single, yV() As Single, zV() As Single
    Dim iType() As AvaxItemType, xc As Single, yc As Single
    Dim vItemProperties() As Variant, vData() As Variant
    Dim hSelected() As Long, fSelected As Boolean, lSelectCnt As Long
    Dim hSel() As Long, lMaxSelected As Long, l As Long
    Dim Fill_iType As Byte
    Dim Fill_lHatchIndex As Long
    Dim Fill_iInForeColor As Integer
    Dim Fill_iInBackColor As Integer
    Dim Fill_sPattern As String
    Dim Fill_zOrder As Long
    Dim Fill_lFlags As Long
    cAvax1.PauseAvaxEvents = True
    lMax = cAvax1.GetAllHandlesArr(hAll())
    lMaxSelected = cAvax1.GetSelectedHandlesArr(hSel())
    ReDim hDel(lMax) As Long
    ReDim hSelected(lMax) As Long
    Call cAvax1.GetAttributes(hAll(), iType(), iColor(), iWidth(), iStyle(), iLayer(), Elevation3D(), Height3D())
    If cAvax1.GetProperties(hAll(), iType(), vItemProperties(), vData()) = True Then
       For lCnt = 1 To lMax
           fSelected = False
           For l = 1 To lMaxSelected
               If hAll(lCnt) = hSel(l) Then fSelected = True: Exit For
           Next l
           If iType(lCnt) = Shape_i Then
              sKey = cAvax1.GetHandleKey(hAll(lCnt))
              xyz() = vData(lCnt)
              Call GetAvaxShapeVertices(xyz(), xV(), yV(), zV())
              If fSelected = True Then
                 Fill_lHatchIndex = 5
                 Fill_iType = AvaxFillType.Pattern_f
                 Fill_sPattern = ""
                 Fill_iInForeColor = 5
                 Fill_iInBackColor = 2
                 h = cAvax1.Add_Shape(xV(), yV(), zV(), vItemProperties(lCnt), Fill_iType, Fill_lHatchIndex, Fill_iInForeColor, Fill_iInBackColor, Fill_sPattern, Fill_zOrder, Fill_lFlags, iColor(lCnt), iWidth(lCnt), iStyle(lCnt), iLayer(lCnt), Polyline_pt)
              Else
                 Fill_lHatchIndex = 0
                 Fill_iType = AvaxFillType.Solid_f
                 Fill_sPattern = ""
                 Fill_iInForeColor = 1
                 Fill_iInBackColor = 0
                 h = 0
                 For l = 1 To LastSelectesObjects
                     If hAll(lCnt) = LastSelectedHandles(l) Then
                        h = cAvax1.Add_Shape(xV(), yV(), zV(), vItemProperties(lCnt), Fill_iType, Fill_lHatchIndex, Fill_iInForeColor, Fill_iInBackColor, Fill_sPattern, Fill_zOrder, Fill_lFlags, iColor(lCnt), iWidth(lCnt), iStyle(lCnt), iLayer(lCnt), Polyline_pt)
                        Exit For
                     End If
                 Next l
              End If
              If h <> 0 Then
                 If fSelected = True Then
                    lSelectCnt = lSelectCnt + 1
                    hSelected(lSelectCnt) = h
                 End If
                 Call cAvax1.SetHandleKey(h, sKey)
                 lDelCnt = lDelCnt + 1
                 hDel(lDelCnt) = hAll(lCnt)
                 If lDelCnt = 1 Then cAvax1.ContinueUndo = True
              End If
           Else
              If fSelected = True Then
                 lSelectCnt = lSelectCnt + 1
                 hSelected(lSelectCnt) = hAll(lCnt)
              End If
           End If
       Next lCnt
    End If
    If lDelCnt <> 0 Then
       ReDim Preserve hDel(lDelCnt) As Long
       Call cAvax1.DeleteItems(hDel())
    End If
    If lSelectCnt <> 0 Then
       ReDim Preserve hSelected(lSelectCnt) As Long
       Call cAvax1.SelectItems(hSelected())
       LastSelectedHandles() = hSelected()
       LastSelectesObjects = lSelectCnt
    End If
    cAvax1.ContinueUndo = False
    cAvax1.PauseAvaxEvents = False
End Sub

Private Sub Command1_Click()
    Dim lCnt As Long
    Dim lMax As Long
    Dim hSel() As Long
    Dim iType() As AvaxItemType
    Dim sProp() As String
    Dim vItemProperties() As Variant
    Dim vData() As Variant
    Dim NewPrice As String
    If cAvax1.IsSelected = True Then
       NewPrice = InputBox("New price=", "Set price", 300000)
       lMax = cAvax1.GetSelectedHandlesArr(hSel())
       If cAvax1.GetProperties(hSel(), iType(), vItemProperties(), vData()) = True Then
          For lCnt = 1 To lMax
              sProp() = vItemProperties(lCnt)
              sProp(2) = "Price=" & NewPrice
              vItemProperties(lCnt) = sProp()
          Next lCnt
          Call cAvax1.SetProperties(hSel(), iType(), vItemProperties(), vData())
          Call cAvax1.SelectItems(hSel())
       End If
    Else
       MsgBox "Select an object...", vbCritical, "Set price"
    End If
End Sub

Private Sub Command2_Click()
    Dim lCnt As Long
    Dim lMax As Long
    Dim hSel() As Long
    Dim iType() As AvaxItemType
    Dim sProp() As String
    Dim vItemProperties() As Variant
    Dim vData() As Variant
    Dim sMsg As String
    Dim sKey As String
    If cAvax1.IsSelected = True Then
       lMax = cAvax1.GetSelectedHandlesArr(hSel())
       If cAvax1.GetProperties(hSel(), iType(), vItemProperties(), vData()) = True Then
          For lCnt = 1 To lMax
              sProp() = vItemProperties(lCnt)
              sKey = cAvax1.GetHandleKey(hSel(lCnt))
              sMsg = sMsg & sKey & "," & sProp(1) & "," & sProp(2) & vbCrLf
          Next lCnt
       End If
       MsgBox sMsg, vbInformation, "Properties"
    Else
       MsgBox "Select an object...", vbCritical, "Properties"
    End If
End Sub

Private Sub CreateTheDrawing()
    Dim h As Long
    Dim sProp() As String
    Dim Fill_iType As Byte
    Dim Fill_lHatchIndex As Long
    Dim Fill_iInForeColor As Integer
    Dim Fill_iInBackColor As Integer
    Fill_lHatchIndex = 0
    Fill_iType = AvaxFillType.Solid_f
    Fill_iInForeColor = 1
    Fill_iInBackColor = 0
    ReDim sProp(2) As String
    sProp(1) = "Area=100"
    sProp(2) = "Price=100000"
    h = cAvax1.Add_ShapeRectangle(0, 0, 5, 5, sProp(), Fill_iType, Fill_lHatchIndex, Fill_iInForeColor, Fill_iInBackColor)
    Call cAvax1.SetHandleKey(h, "Building 1")
    Call cAvax1.Add_Text("Building 1", 0, -2, 0, , 5)
    sProp(1) = "Area=200"
    sProp(2) = "Price=200000"
    h = cAvax1.Add_ShapeRectangle(6, 6, 5, 5, sProp(), Fill_iType, Fill_lHatchIndex, Fill_iInForeColor, Fill_iInBackColor)
    Call cAvax1.SetHandleKey(h, "Building 2")
    Call cAvax1.Add_Text("Building 2", 6, 12, 0, , 5)
End Sub

Private Function GetAvaxShapeVertices(xyz() As Single, xV() As Single, yV() As Single, zV() As Single) As Boolean
    Dim lCnt As Integer, lCount As Long, lMax As Long
    lMax = UboundSngX(xyz)
    If lMax = 0 Or (lMax Mod 3) <> 0 Then Exit Function
    lMax = lMax / 3
    If lMax <= 2 Then Exit Function
    ReDim xV(lMax) As Single, yV(lMax) As Single, zV(lMax) As Single
    lCount = 0
    For lCnt = 1 To lMax
        lCount = lCount + 1
        xV(lCnt) = xyz(lCount)
        lCount = lCount + 1
        yV(lCnt) = xyz(lCount)
        lCount = lCount + 1
        zV(lCnt) = xyz(lCount)
    Next lCnt
    If IsSamePoint(xV(1), yV(1), xV(lMax), yV(lMax)) = False Then
       lCnt = lMax + 1
       ReDim Preserve xV(lCnt) As Single
       ReDim Preserve yV(lCnt) As Single
       ReDim Preserve zV(lCnt) As Single
       xV(lCnt) = xV(1)
       yV(lCnt) = yV(1)
       zV(lCnt) = zV(1)
    End If
    GetAvaxShapeVertices = True
End Function

Private Function IsSamePoint(xa1 As Single, ya1 As Single, xb1 As Single, yb1 As Single) As Boolean
    If IsZero(xa1 - xb1) = True And IsZero(ya1 - yb1) = True Then
       IsSamePoint = True
    Else
       IsSamePoint = False
    End If
End Function

Private Function IsZero(A As Single) As Boolean
    If Abs(A) < 0.0001 Then IsZero = True Else IsZero = False
End Function

Private Function UboundSngX(A() As Single) As Long
    On Local Error GoTo Lab_error
    UboundSngX = UBound(A)
    Exit Function
Lab_error:
    UboundSngX = 0
End Function