无法修改多段线的坐标？？？

Oceanable

问题描述：写了个类模块OceDoor，图中选择一个矩形多段线后，发现修改多段线坐标后没有反应......


1）以下是 ThisDrawing 里面的代码：
==========================================================================================
Public Sub BBB_GoTestHere()    这个是运行的主过程

Dim SeleObjts As AcadSelectionSet
Dim Objt As Object
Dim Door As New OceDoor

Call CreateSelectionSet(SeleObjts, "Doors"):   SeleObjts.SelectOnScreen

For Each Objt In SeleObjts
  If TypeOf Objt Is AcadLWPolyline Then Set Door.OutLine = Objt
Next Objt

Set SeleObjts = Nothing

Let Door.Width = 5000    这设置宽度，原来宽度是 1200，运行后矩形没变大

End Sub

==========================================================================================
Sub CreateSelectionSet(SeleObjts As AcadSelectionSet, Name As String)

On Error Resume Next

If Not IsNull(ThisDrawing.SelectionSets.Item(Name)) Then
  Set SeleObjts = ThisDrawing.SelectionSets.Item(Name)
  SeleObjts.Delete
End If

Set SeleObjts = ThisDrawing.SelectionSets.Add(Name)

End Sub
==========================================================================================


2）以下是 OceDoor 里面的代码：

Dim Rect As AcadLWPolyline
Dim b0 As Double:  Dim Xc As Double

==========================================================================================
Public Property Set OutLine(ByVal NewValue As AcadLWPolyline)
    Set Rect = NewValue:  Call DataUpdate
End Property
==========================================================================================
Public Property Get OutLine() As AcadLWPolyline
    Set OutLine = Rect
End Property
==========================================================================================
Private Sub DataUpdate()   数据更新
    b0 = Abs(Rect.Coordinate(1)(0) - Rect.Coordinate(3)(0))
    h0 = Abs(Rect.Coordinate(1)(1) - Rect.Coordinate(3)(1))
    Xc = 0.5 * (Rect.Coordinate(1)(0) + Rect.Coordinate(3)(0))
    Yc = 0.5 * (Rect.Coordinate(1)(1) + Rect.Coordinate(3)(1))  
    Rect.Update
End Sub
==========================================================================================
Public Property Get Width() As Double    宽度属性取值
    Width = b0
End Property
==========================================================================================
Public Property Let Width(ByVal NewValue As Double)     宽度属性赋值
    Dim Xmax As Double:  Xmax = Xc + 0.5 * NewValue
    Dim Xmin As Double:  Xmin = Xc - 0.5 * NewValue

    Rect.Coordinate(0)(0) = Xmin：    Rect.Coordinate(2)(0) = Xmax
    Rect.Coordinate(1)(0) = Xmax：   Rect.Coordinate(3)(0) = Xmin

    Call DataUpdate
End Property

Oceanable

简化下代码，这样也无法修改坐标：

Option Explicit

Public Sub BBB_GoTestHere()

Dim SeleObjts As AcadSelectionSet
Dim Objt As Object

Dim Rect As AcadPolyline

Call CreateSelectionSet(SeleObjts, "Polys")

SeleObjts.SelectOnScreen

For Each Objt In SeleObjts
  If TypeOf Objt Is AcadPolyline Then Set Rect = Objt
Next Objt

Set SeleObjts = Nothing

Rect.Coordinates(0) = 5000  '就是这里，根本改不了坐标

End Sub

Sub CreateSelectionSet(SeleObjts As AcadSelectionSet, Name As String)

On Error Resume Next

If Not IsNull(ThisDrawing.SelectionSets.Item(Name)) Then
Set SeleObjts = ThisDrawing.SelectionSets.Item(Name)
SeleObjts.Delete
End If

Set SeleObjts = ThisDrawing.SelectionSets.Add(Name)

End Sub

woaishuijia

2. Public Property Let Width(ByVal NewValue As Double)   
   
3.     Dim Xmax As Double:  Xmax = Xc + 0.5 * NewValue
   
4.     Dim Xmin As Double:  Xmin = Xc - 0.5 * NewValue
   
5.    
   
6.     Dim V(7) As Double
   
7.     V(0) = Xmin
   
8.     V(1) = Rect.Coordinates(1)
   
9.     V(2) = Xmax
   
10.     V(3) = Rect.Coordinates(3)
    
11.     V(4) = Xmax
    
12.     V(5) = Rect.Coordinates(5)
    
13.     V(6) = Xmin
    
14.     V(7) = Rect.Coordinates(7)
    
15.     Rect.Coordinates = V
    
16. 
    
17.     Call DataUpdate
    
18. End Property

Public Property Let Width(ByVal NewValue As Double)    <br />     Dim Xmax As Double:  Xmax = Xc + 0.5 * NewValue<br />     Dim Xmin As Double:  Xmin = Xc - 0.5 * NewValue<br />     <br />     Dim V(7) As Double<br />     V(0) = Xmin<br />     V(1) = Rect.Coordinates(1)<br />     V(2) = Xmax<br />     V(3) = Rect.Coordinates(3)<br />     V(4) = Xmax<br />     V(5) = Rect.Coordinates(5)<br />     V(6) = Xmin<br />     V(7) = Rect.Coordinates(7)<br />     Rect.Coordinates = V<br /> <br />     Call DataUpdate<br /> End Property

或

2. Public Property Let Width(ByVal NewValue As Double)
   
3.     Dim Xmax As Double:  Xmax = Xc + 0.5 * NewValue
   
4.     Dim Xmin As Double:  Xmin = Xc - 0.5 * NewValue
   
5.    
   
6.     Dim V(1) As Double
   
7.     V(0) = Xmin
   
8.     V(1) = Rect.Coordinates(1)
   
9.     Rect.Coordinate(0) = V
   
10.     V(1) = Rect.Coordinates(7)
    
11.     Rect.Coordinate(3) = V
    
12.     V(0) = Xmax
    
13.     V(1) = Rect.Coordinates(3)
    
14.     Rect.Coordinate(1) = V
    
15.     V(1) = Rect.Coordinates(5)
    
16.     Rect.Coordinate(2) = V
    
17. 
    
18.     Call DataUpdate
    
19. End Property

Public Property Let Width(ByVal NewValue As Double)<br />     Dim Xmax As Double:  Xmax = Xc + 0.5 * NewValue<br />     Dim Xmin As Double:  Xmin = Xc - 0.5 * NewValue<br />     <br />     Dim V(1) As Double<br />     V(0) = Xmin<br />     V(1) = Rect.Coordinates(1)<br />     Rect.Coordinate(0) = V<br />     V(1) = Rect.Coordinates(7)<br />     Rect.Coordinate(3) = V<br />     V(0) = Xmax<br />     V(1) = Rect.Coordinates(3)<br />     Rect.Coordinate(1) = V<br />     V(1) = Rect.Coordinates(5)<br />     Rect.Coordinate(2) = V<br /> <br />     Call DataUpdate<br /> End Property

Oceanable

就是不能单个坐标这样修改，，，

谢谢！！！