三维管道空视图的画法-带弯头处理方法

兰州人

  '连接AutoCAD
  If boo = False Then
     AutoCADConnect
  End If
  'Microsoft.Jet.OLEDB.4.0引擎，运行ACCESS2000;
  CreateConnection ("directory.mdb")
  '设置rst1数据集，目的得到无重复的管段号
  Dim rst1 As ADODB.Recordset
  Set rst1 = New ADODB.Recordset
  rst1.CursorLocation = adUseClient
  rst1.Open "SELECT DISTINCT PipeLineNo FROM PipeLine", cn, adOpenForwardOnly, _
            adLockBatchOptimistic, adCmdText
''

 
  Dim point1(0 To 2) As Double, point2(0 To 2) As Double, point3() As Double
  Dim ii As Integer
  Dim Str_Handle() As String
  Dim txtRst1 As String
  Dim Ent As Object
  Dim LineStart As Variant, LineEnd As Variant
  Dim ArcStart As Variant, ArcEnd As Variant
  Dim Cir As Object
 
'

Do Until rst1.EOF '循环无重复的管段号
  txtRst1 = rst1.Fields(0)
  SetLayer (txtRst1)
 
  Set rst = New ADODB.Recordset
  rst.CursorLocation = adUseClient
  rst.Open "SELECT DISTINCT * FROM PipeLine where PipeLineNo = '" & txtRst1 & "' Order by ID", cn, adOpenForwardOnly, _
            adLockBatchOptimistic, adCmdText
  '必须用Order by ID，否则会产生Handle标识不连续，无法执行fillet命令。
  rst.MoveFirst
  '
  Dim Command As String, RR As Double
  RR = rst!Dn * 1.5
  ''
  Command = "fillet" + Chr(10) + "R" + Chr(10) + Trim(Str(RR)) + Chr(10) + Chr(10)
  obj_Doc.SendCommand Command
'
  ReDim Str_Handle(rst.RecordCount) As String
'''

  ii = 1
  Do Until rst.EOF
    point1(0) = rst!pointX0: point1(1) = rst!pointY0: point1(2) = rst!pointZ0
    point2(0) = rst!pointX: point2(1) = rst!pointY: point2(2) = rst!pointZ
    Set Ent = obj_ModelSpace.AddLine(point1, point2)
    With rst '处理字段，可视性好。
      .Fields(3).Value = Trim(Ent.Handle)
      .Update
      .MoveNext
    End With
    Str_Handle(ii) = Trim(Ent.Handle)
    ii = ii + 1
  Loop
  rst.UpdateBatch (adAffectAllChapters) '批量更新数据库
''
  rst.MoveFirst
  For ii = 1 To rst.RecordCount - 1
    Command = "fillet" + Chr(10) + "(handent " & Chr(34) & Str_Handle(ii) & Chr(34) & ")" & Chr(10) + "(handent " & Chr(34) & Str_Handle(ii + 1) & Chr(34) & ")" & Chr(10)
    obj_Doc.SendCommand Command
    Dim nn As Integer
    nn = obj_ModelSpace.Count - 1
    Set Ent = obj_ModelSpace.Item(nn)
''
    ArcStart = Ent.startPoint
    ArcEnd = Ent.endPoint
    Set Cir = obj_ModelSpace.AddCircle(ArcEnd, RR)
    Cir.Color = 1
   
    With rst  '批量更新数据库
      !ArcHandleID = Trim(Ent.Handle)
      !ArcX0 = ArcStart(0)
      !ArcY0 = ArcStart(1)
      !ArcZ0 = ArcStart(2)
      !ArcX = ArcEnd(0)
      !ArcY = ArcEnd(1)
      !ArcZ = ArcEnd(2)
      .UpdateBatch
      .MoveNext
    End With
  Next
 
''
  For ii = 1 To rst.RecordCount
    Set Ent = obj_Doc.HandleToObject(Str_Handle(ii))
    LineStart = Ent.startPoint: LineEnd = Ent.endPoint
    Set Cir = obj_ModelSpace.AddCircle(LineStart, RR)
    Cir.Color = 4
    With rst
      !PipeLineX0 = LineStart(0)
      !PipeLineY0 = LineStart(1)
      !PipeLineZ0 = LineStart(2)
      !PipeLineX = LineEnd(0)
      !PipeLineY = LineEnd(1)
      !PipeLineZ = LineEnd(2)
    End With
  Next ii
  rst1.MoveNext
Loop