Tag Archives: extend line

zAware, add point to polyline, extend line, query filter, query nearest point

Do While Not pFeature Is Nothing
Dim pEndPt As IPoint
Dim pLine As IPolyline

pLine = pFeature.Shape
pEndPt = pLine.ToPoint

Dim pProxOpLine As IProximityOperator

Dim pFromPt As New Point
Dim pQueryFilter As IQueryFilter
pQueryFilter = New QueryFilter
‘pQFilt.WhereClause =

pQueryFilter.WhereClause = cboRefID.Text & ” = ‘” & pFeature.Value(pFeature.Fields.FindField(cboRefField.Text)) & “‘”
‘ MsgBox(pQueryFilter.WhereClause)

Dim kFeatureLayer As IFeatureLayer
kFeatureLayer = pMxDoc2.FocusMap.Layer(GetLayerIndex(.cboRefLayer.Text))
Dim kFeatureClass As IFeatureClass = kFeatureLayer.FeatureClass

Dim kFeatureCursor As IFeatureCursor = kFeatureClass.Search(pQueryFilter, False)

If kFeatureClass.FeatureCount(pQueryFilter) > 0 Then
Dim kFeature As IFeature = kFeatureCursor.NextFeature

If Not kFeature Is Nothing Then
pProxOpLine = kFeature.Shape
pProxOpLine.QueryNearestPoint(pEndPt, esriSegmentExtension.esriNoExtension, pFromPt)
‘Dim pPolyline As New Polyline
‘ pPolyline.AddPoint(pFromPt)
Dim pPointsF As IPointCollection = pLine

Dim zAware As IZAware = CType(pFromPt, IZAware)
zAware.ZAware = True
pFromPt.Z = pEndPt.Z
pPointsF.AddPoint(pFromPt)

Dim Dist As Double = txtDist.Text

If Not Dist = 0 Then
Dim x As Double
Dim y As Double

If pEndPt.X = pFromPt.X Then

x = pFromPt.X
If pFromPt.Y > pEndPt.Y Then
y = pFromPt.Y + Dist
Else
y = pFromPt.Y – Dist
End If

Else

Dim m As Double

m = (pEndPt.Y – pFromPt.Y) / (pEndPt.X – pFromPt.X)

x = Math.Sqrt(Dist * Dist / (1 + m * m))

If pFromPt.X < pEndPt.X Then
x = pFromPt.X – x
Else
x = pFromPt.X + x
End If

y = m * (x – pFromPt.X) + pFromPt.Y

End If

Dim PtAdd As New Point
PtAdd.X = x
PtAdd.Y = y

Dim zAware2 As IZAware = CType(PtAdd, IZAware)
zAware2.ZAware = True
PtAdd.Z = pEndPt.Z

pPointsF.AddPoint(PtAdd)

End If
pFeature.Shape = pLine
pFeature.Store()

'If Not pFromPt Is Nothing Then
' pProxOpLine.AddPoint(pFromPt)

' End If
'pPolyline.AddPoint(pFromPt)
' pPolyline.AddPoint(pEndPt)

End If
End If

pFeature = pFeatureCursor.NextFeature

Loop

Advertisements