VB.net: Perpendicular lines to

Jozi68 · 发表于 2022-7-6 06:26:54

I use vb.net. I work in 2D.
I have a certain point (Point3D). I have a certain polyline. I need to draw a perpendicular line from the point to the polyline. Any ideas on how to do that??

SEANT · 发表于 2022-7-6 06:34:07

This is typically done with Curve.GetClosestPointTo(). The point returned from that method can be combined with the input point to create a line.

Jozi68 · 发表于 2022-7-6 06:37:20

Thanx Seant,
Can you please show me how to implement this statement? I have no idea how.

SEANT · 发表于 2022-7-6 06:41:43

There may be a detail or two overlooked in this sample, but it shows the general idea.

copy

   Public Sub Per2Poly()       Dim db As Database = HostApplicationServices.WorkingDatabase       Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor       db.Pdmode = 66 'just to make the points more visible       Dim tr As Transaction = db.TransactionManager.StartTransaction()       Dim peo As PromptEntityOptions = New PromptEntityOptions(vbCr & "Select a lwpline: ")       peo.SetRejectMessage(vbCr & "Please select lightweight polyline only! ")       peo.AddAllowedClass(GetType(Polyline), True)       Try           Dim per As PromptEntityResult = ed.GetEntity(peo)           If per.Status  PromptStatus.OK Then Exit Sub           Dim mat As Matrix3d = ed.CurrentUserCoordinateSystem           Dim pl As Polyline = tr.GetObject(per.ObjectId, OpenMode.ForRead)           Dim ppo As PromptPointOptions = New PromptPointOptions(vbCr & "Select point from which to strike a perpendicular: " & vbLf)           ppo.AllowNone = True           Dim ppr As PromptPointResult = ed.GetPoint(ppo)           If ppr.Status  PromptStatus.OK Then Exit Sub           Dim basePt As Point3d = ppr.Value.TransformBy(mat)           Dim pt As Point3d = pl.GetClosestPointTo(basePt, False) 'crux of the process           Dim v3d As Vector3d = basePt.GetVectorTo(pt)       'Test if closest point is indeed perpendicular.           Dim derV3d As Vector3d = pl.GetFirstDerivative(pt) '           If v3d.IsPerpendicularTo(derV3d) Then              '               Dim ln As Line = New Line(basePt, pt)               Dim btr As BlockTableRecord = tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite)               ln.SetDatabaseDefaults()               btr.AppendEntity(ln)               tr.AddNewlyCreatedDBObject(ln, True)               tr.Commit()           Else               ed.WriteMessage(vbCr & "Perpendicular not found!")           End If       Catch ex As Exception           tr.Abort()           ed.WriteMessage("Error during execution! " & ex.Message)       Finally           tr.Dispose()       End Try   End Sub

Jozi68 · 发表于 2022-7-6 06:48:23

Thanx SEANT,
I got it to work

zeus · 发表于 2022-7-6 06:52:06

Hi Seant,
I tried to to used part of your code...but i am planning to replace the PPR value input with loop of point3d in the point3dcollection but it gives me an error. I would like to ask how to do it correctly.

                  For Each vx As Point3d In VertexPts
                     Dim basept As Point3d = vx.TransformBy(mat)
                     Dim pt As Point3d = poly2.GetClosestPointTo(basept, False)
                     Dim v3d As Vector3d = basept.GetVectorTo(pt)
                     Dim derv3d As Vector3d = poly2.GetFirstDerivative(pt)

                     If v3d.IsPerpendicularTo(derv3d) Then
                        Dim ln As Line = New Line(basept, pt)
                        Dim btr As BlockTableRecord = trans.GetObject(db.CurrentSpaceId, OpenMode.ForWrite)
                        ln.SetDatabaseDefaults()
                        btr.AppendEntity(ln)
                        trans.AddNewlyCreatedDBObject(ln, True)
                        trans.Commit()
                     Else
                        ed.WriteMessage(vbCr & "Perpendicular not found!")
                     End If
                  Next

SEANT · 发表于 2022-7-6 06:59:08

At which line of code does the error occur?

zeus · 发表于 2022-7-6 06:59:34

the error message point the error to this line

Dim btr As BlockTableRecord = trans.GetObject(db.CurrentSpaceId, OpenMode.ForWrite)

during the program execution it only creates one line to the first point point3d which is perpendicular to the polyline the rest does not...

SEANT · 发表于 2022-7-6 07:05:37

Oops! I guess I should have seen that as a problem.

These line really need to be on the outside of the For Loop.

copy

Dim btr As BlockTableRecord = trans.GetObject(db.CurrentSpaceId, OpenMode.ForWrite)For Each vx As Point3d In VertexPts   Dim basept As Point3d = vx.TransformBy(mat)   Dim pt As Point3d = poly2.GetClosestPointTo(basept, False)   Dim v3d As Vector3d = basept.GetVectorTo(pt)   Dim derv3d As Vector3d = poly2.GetFirstDerivative(pt)   If v3d.IsPerpendicularTo(derv3d) Then       Dim ln As Line = New Line(basept, pt)       ln.SetDatabaseDefaults()       btr.AppendEntity(ln)       trans.AddNewlyCreatedDBObject(ln, True)   End IfNexttrans.Commit()

It might also make sense to "Dim" all the variable prior to the for loop - just assign them within the loop.

BlackBox · 发表于 2022-7-6 07:09:24

That's only necessary if the variables are going to be used outside of the FOR loop's scope (before, or after)... i.e., if one needs to further manipulate a variable's Object, or use as Returned value.

[编程交流] VB.net: Perpendicular lines to

发表回复

精选推荐

浏览过的版块