How to realize 3d Offset?

Code Red > .NET

(1/4) > >>

gilseorin:
I have difficulty in realize 3d Offset.
I have been doing with my code for three weeks.
Any help would be appreciated.
Thanks in advance.

Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports System.Math
Public Class GILSclass1
<CommandMethod("TOS")> _
Public Sub TdOffset()
Dim Db As Database = HostApplicationServices.WorkingDatabase
Dim Ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
Dim Tr As Transaction = Db.TransactionManager.StartTransaction
Try
Dim EntSelOpt As PromptEntityOptions = New PromptEntityOptions("" & Microsoft.VisualBasic.Chr(10) & "Select 3dPolyLine: ")
EntSelOpt.SetRejectMessage("" & Microsoft.VisualBasic.Chr(10) & "Only Selected 3d PolyLine!")
EntSelOpt.AddAllowedClass(GetType(Polyline3d), True)
Dim EntSelRes As PromptEntityResult = Ed.GetEntity(EntSelOpt)
If EntSelRes.Status <> PromptStatus.OK Then Return

Dim DrOpt As PromptPointOptions = New PromptPointOptions("" & Microsoft.VisualBasic.Chr(10) & "Specify Offset Direction: ")
Dim Dres As PromptPointResult = Ed.GetPoint(DrOpt)

Dim DrDst As PromptDoubleOptions = New PromptDoubleOptions("" & Microsoft.VisualBasic.Chr(10) & "Input Offset Distance: ")
Dim Ddst As PromptDoubleResult = Ed.GetDouble(DrDst)

Dim Z_Sig As PromptDoubleOptions = New PromptDoubleOptions("" & Microsoft.VisualBasic.Chr(10) & "Input Z Value: ")
Dim Z_res As PromptDoubleResult = Ed.GetDouble(Z_Sig)

Dim Ent As Polyline3d = CType(Tr.GetObject(EntSelRes.ObjectId, OpenMode.ForRead), Polyline3d)
Dim c As Curve = DirectCast(Ent, Curve)
Dim sp As Double = c.StartParam
Dim ep As Double = c.EndParam

Dim ssp As Point3d = c.GetPointAtParameter(sp)
Dim eep As Point3d = c.GetPointAtParameter(ep)

Dim Vspdr As Double = V(Dres.Value, ssp)

Dim bt As BlockTable = Tr.GetObject(Db.BlockTableId, OpenMode.ForRead)
Dim btr As BlockTableRecord = Tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
Dim pts As Point3dCollection = New Point3dCollection
Dim FnPt As Point3d
Dim fts As Point3dCollection = New Point3dCollection

Dim qqq As Vector3d = New Vector3d
Dim ppp As Vector3d = New Vector3d
ppp.CrossProduct(qqq)

Dim n As Integer = 0
For p As Double = sp To ep Step 1.0
n = n + 1
Dim pt As Point3d = c.GetPointAtParameter(p)
Dim gt As Point3d = New Point3d(pt.X, pt.Y, pt.Z + Z_res.Value)
Dim Vptnt As Double
Dim nt As Point3d
If p <> ep Then
nt = c.GetPointAtParameter(p + 1.0)
Vptnt = V(nt, pt)
ElseIf p = ep Then
End If
Dim SndPt1 As Point3d
Dim SndPt2 As Point3d
Dim Vfn As Double
Select Case (Vspdr > 0 Or Vspdr = 0) AndAlso Vspdr < Atan(1) * 4
Case True
Vfn = Vptnt + 2 * Atan(1)
SndPt1 = PolarPoint(Dst(pt, nt).Item(0), Vfn, Ddst.Value)
SndPt2 = PolarPoint(Dst(pt, nt).Item(1), Vfn, Ddst.Value)
Case False
Vfn = Vptnt - 2 * Atan(1)
SndPt1 = PolarPoint(Dst(gt, nt).Item(0), Vfn, Ddst.Value)
SndPt2 = PolarPoint(Dst(gt, nt).Item(1), Vfn, Ddst.Value)
End Select
pts.Add(SndPt1)
pts.Add(SndPt2)
If p <> sp AndAlso p <> ep Then
FnPt = API(pts.Item(2 * n - 4), pts.Item(2 * n - 3), pts.Item(2 * n - 2), pts.Item(2 * n - 1))
Dim FnlPt As Point3d = New Point3d(FnPt.X, FnPt.Y, gt.Z)
fts.Add(FnlPt)
ElseIf p = sp Then
FnPt = PolarPoint(pt, Vfn, Ddst.Value)
Dim fnlpt As Point3d = New Point3d(SndPt1.X, SndPt1.Y, gt.Z)
fts.Add(fnlpt)
ElseIf p = ep Then
Select Case (Vspdr > 0 Or Vspdr = 0) AndAlso Vspdr < Atan(1) * 4
Case True
Vfn = Vptnt + 2 * Atan(1)
Case False
Vfn = Vptnt - 2 * Atan(1)
End Select
FnPt = PolarPoint(pt, Vfn, Ddst.Value)
Dim fnlpt As Point3d = New Point3d(SndPt1.X, SndPt1.Y, gt.Z)
fts.Add(fnlpt)
End If

Next

Dim my3dpoly As Polyline3d = New Polyline3d(Poly3dType.SimplePoly, fts, False)

btr.AppendEntity(my3dpoly)
Tr.AddNewlyCreatedDBObject(my3dpoly, True)
Tr.Commit()
Catch

Finally
Tr.Dispose()
End Try
End Sub
Friend Function PolarPoint(ByVal BasePoint As Point3d, ByVal angle As Double, ByVal distance As Double) As Point3d
Dim x As Double = distance * Cos(angle)
Dim y As Double = distance * Sin(angle)
Return New Point3d(BasePoint.X + x, BasePoint.Y + y, BasePoint.Z)
End Function
Friend Function API(ByVal p1 As Point3d, ByVal p2 As Point3d, ByVal p3 As Point3d, ByVal p4 As Point3d) As Point3d
Dim angAp As Double = Atan((p2.Y - p1.Y) / (p2.X - p1.X))
Dim angBt As Double = Atan((p4.Y - p3.Y) / (p4.X - p3.X))
Dim ar1 As Double = (((p3.Y - p1.Y) * Cos(angBt) - (p3.X - p1.X) * Sin(angBt)) / Sin(angAp - angBt))
Dim ar2 As Double = (((p3.Y - p1.Y) * Cos(angAp) - (p3.X - p1.X) * Sin(angAp)) / Sin(angAp - angBt))
Dim x As Double = p1.X + ar1 * Cos(angAp)
Dim y As Double = p1.Y + ar1 * Sin(angAp)
Return New Point3d(x, y, 0)
End Function
Friend Function BPI(ByVal p1 As Point3d, ByVal p2 As Point3d, ByVal p3 As Point3d, ByVal p4 As Point3d) As Point3d
Dim angAp As Double = Atan((p2.Y - p1.Y) / (p2.X - p1.X))
Dim angBt As Double = Atan((p4.Y - p3.Y) / (p4.X - p3.X))
Dim ar1 As Double = (((p3.Y - p1.Y) * Cos(angBt) - (p3.X - p1.X) * Sin(angBt)) / Sin(angAp - angBt))
Dim ar2 As Double = (((p3.Y - p1.Y) * Cos(angAp) - (p3.X - p1.X) * Sin(angAp)) / Sin(angAp - angBt))
Dim x As Double = p1.X + ar1 * Cos(angAp)
Dim y As Double = p1.Y + ar1 * Sin(angAp)
Return New Point3d(x, y, 0)
End Function
Friend Function V(ByVal p1 As Point3d, ByVal p2 As Point3d) As Double
Dim ang As Double = Atan((p2.Y - p1.Y) / (p2.X - p1.X))
Return ang
End Function
Friend Function Dst(ByVal p1 As Point3d, ByVal p2 As Point3d) As Point3dCollection
Dim ds As Double = Sqrt((p2.X - p1.X) ^ 2 + (p2.Y - p1.Y) ^ 2)
Dim va As Double = V(p1, p2)
Dim s1 As Point3d = PolarPoint(p1, va, ds / 3)
Dim s2 As Point3d = PolarPoint(p1, va, ds * 2 / 3)
Dim ggc As Point3dCollection = New Point3dCollection
ggc.Add(s1)
ggc.Add(s2)
Return ggc
End Function

End Class

Glenn R:
More dual posting < shakes head >...Help you not, I will.

Kerry:
Can you describe where and how it is failing you.
That may help.

I don't like VB, so find it difficult to scan read and assimilate.
What is it supposed to do.
What does it do.
What won't it do.

gilseorin:
I attached my code with C#.
It works but not into right direction.
It contains many problem to solve.
If I knew what the problem is, I would solve it for myself.
I can't describe on my code, but general access is available.

First,
PromptPointOptions DrOpt = new PromptPointOptions("" + Microsoft.VisualBasic.Chr(10) + "Specify Offset Direction: ");
PromptPointResult Dres = Ed.GetPoint(DrOpt);

How to determine where the point is situated of the selected 3dPolyline? Up,down,left,right?

Second,
How to collect right point as in general offset in AutoCad command "offset"?

Kerry:

--- Quote ---If I knew what the problem is, I would solve it for myself.
--- End quote ---

Please understand :

The Problem is " what is wrong" or "what is not working" or "How can I do this"

The Solution is how you would solve it.

So you CAN know the problem without being able to solve it.

just a different way of thinking ...

Navigation

[0] Message Index

[#] Next page

Go to full version