arc & pline

[mehrdad]

Me a arc, but I cannot arc to the beginning of a line from the center and the center of the arc to killPlease help

"Visual Basic with AutoCAD software"

Edited December 9, 2011 by mehrdad

[Organic]

Interesting question... perhaps upload the drawing and provide some more details about the problem?

[mehrdad]

Visual Basic with AutoCAD software

[fixo]

Upload your picture here from screenshot in .jpeg or .png format

to show us what you want

[fixo]

 
<CommandMethod("twoarcs")> _
Public Sub AddArcsOnLine()
Dim acDoc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim ed As Editor = acDoc.Editor
Dim db As Database = acDoc.Database
Dim mtx As Matrix3d = ed.CurrentUserCoordinateSystem
Dim ucs As CoordinateSystem3d = mtx.CoordinateSystem3d
Try
Using tr As Transaction = db.TransactionManager.StartTransaction
Dim peo As New PromptEntityOptions(vbLf & "Select line >>")
peo.SetRejectMessage(vbLf & "Selected is not a line>>")
peo.AddAllowedClass(GetType(Line), False)
Dim res As PromptEntityResult
res = ed.GetEntity(peo)
If res.Status <> PromptStatus.OK Then
Return
End If
Dim ent As Entity = DirectCast(tr.GetObject(res.ObjectId, OpenMode.ForRead), Entity)
If ent Is Nothing Then
Return
End If
Dim lin As Line = Nothing
If TypeOf ent Is Line Then
lin = DirectCast(ent, Line)
End If
Dim btr As BlockTableRecord = tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite) '<-- get current space
Dim plan As Plane = New Plane(Point3d.Origin, ucs.Zaxis)
Dim p1 As Point3d = lin.StartPoint
Dim p2 As Point3d = lin.EndPoint
Dim ang = lin.Angle
Dim mpt As Point3d = New Point3d((p1.X + p2.X) / 2, (p1.Y + p2.Y) / 2, (p1.Z + p2.Z) / 2)
Dim cpt1 As Point3d = New Point3d((p1.X + mpt.X) / 2, (p1.Y + mpt.Y) / 2, (p1.Z + mpt.Z) / 2)
Dim cpt2 As Point3d = New Point3d((mpt.X + p2.X) / 2, (mpt.Y + p2.Y) / 2, (mpt.Z + p2.Z) / 2)
Dim arc1 As Arc = New Arc(cpt1, lin.GetDistAtPoint(cpt1), ang, Math.PI + ang)
arc1.Normal = lin.Normal
btr.AppendEntity(arc1)
tr.AddNewlyCreatedDBObject(arc1, True)
Dim arc2 As Arc = New Arc(cpt2, lin.GetDistAtPoint(cpt1), ang, Math.PI + ang)
arc1.Normal = lin.Normal
btr.AppendEntity(arc2)
tr.AddNewlyCreatedDBObject(arc2, True)
tr.Commit()
End Using
Catch ex As System.Exception
Autodesk.AutoCAD.ApplicationServices.Application.ShowAlertDialog(String.Format( _
"ERROR: " & Environment.NewLine & "{0}" & Environment.NewLine _
& "TRACE: " + Environment.NewLine + "{1}", ex.Message, ex.StackTrace))
Finally
'do nothing
End Try
End Sub

[mehrdad]

thanks a lot

but I'm sorry because this program is inactive

[fixo]

My bad,

Do you want to do it on VBA???

 

 
Option Explicit
Public Sub AddTwoArcs()
Dim sset As AcadSelectionSet
Dim dxfCode, dxfValue
Dim ftype(0) As Integer
Dim fdata(0) As Variant
ftype(0) = 0: fdata(0) = "LINE"
dxfCode = ftype: dxfValue = fdata
Dim lineObj As Object
Dim oEnt As AcadEntity
Dim stPt As Variant
Dim endPt As Variant
Dim movePt As Variant
Dim perpAng As Double
Dim rotAng As Double
Dim PI As Double
PI = Atn(1) * 4
' Define the new selection set object
With ThisDrawing.SelectionSets
While .Count > 0
.Item(0).Delete
Wend
Set sset = .Add("$Lines$")
End With
sset.SelectOnScreen dxfCode, dxfValue
If sset.Count = 0 Then
MsgBox ("No lines selected")
Exit Sub
End If
For Each oEnt In sset
' get the line object
Set lineObj = oEnt
stPt = lineObj.StartPoint
endPt = lineObj.EndPoint
Dim dblAng As Double
' get line angle
dblAng = lineObj.Angle
Dim mpt(2) As Double
Dim cpt1(2) As Double
Dim cpt2(2) As Double
Dim leng As Double
leng = lineObj.Length
Dim tmp As Variant
tmp = ThisDrawing.Utility.PolarPoint(stPt, dblAng, leng / 4)
cpt1(0) = tmp(0): cpt1(1) = tmp(1): cpt1(2) = 0#
tmp = ThisDrawing.Utility.PolarPoint(stPt, dblAng, leng * 0.75)
cpt2(0) = tmp(0): cpt2(1) = tmp(1): cpt2(2) = 0#
Dim oArc1 As AcadArc
Set oArc1 = ThisDrawing.ModelSpace.AddArc(cpt1, leng / 4, dblAng, dblAng + PI)
Dim oArc2 As AcadArc
Set oArc2 = ThisDrawing.ModelSpace.AddArc(cpt2, leng / 4, dblAng, dblAng + PI)

Next
End Sub

Edited December 10, 2011 by fixo
code added

[mehrdad]

My bad,

Do you want to do it on VBA???

 

 
Option Explicit
Public Sub AddTwoArcs()
Dim sset As AcadSelectionSet
Dim dxfCode, dxfValue
Dim ftype(0) As Integer
Dim fdata(0) As Variant
ftype(0) = 0: fdata(0) = "LINE"
dxfCode = ftype: dxfValue = fdata
Dim lineObj As Object
Dim oEnt As AcadEntity
Dim stPt As Variant
Dim endPt As Variant
Dim movePt As Variant
Dim perpAng As Double
Dim rotAng As Double
Dim PI As Double
PI = Atn(1) * 4
' Define the new selection set object
With ThisDrawing.SelectionSets
While .Count > 0
.Item(0).Delete
Wend
Set sset = .Add("$Lines$")
End With
sset.SelectOnScreen dxfCode, dxfValue
If sset.Count = 0 Then
MsgBox ("No lines selected")
Exit Sub
End If
For Each oEnt In sset
' get the line object
Set lineObj = oEnt
stPt = lineObj.StartPoint
endPt = lineObj.EndPoint
Dim dblAng As Double
' get line angle
dblAng = lineObj.Angle
Dim mpt(2) As Double
Dim cpt1(2) As Double
Dim cpt2(2) As Double
Dim leng As Double
leng = lineObj.Length
Dim tmp As Variant
tmp = ThisDrawing.Utility.PolarPoint(stPt, dblAng, leng / 4)
cpt1(0) = tmp(0): cpt1(1) = tmp(1): cpt1(2) = 0#
tmp = ThisDrawing.Utility.PolarPoint(stPt, dblAng, leng * 0.75)
cpt2(0) = tmp(0): cpt2(1) = tmp(1): cpt2(2) = 0#
Dim oArc1 As AcadArc
Set oArc1 = ThisDrawing.ModelSpace.AddArc(cpt1, leng / 4, dblAng, dblAng + PI)
Dim oArc2 As AcadArc
Set oArc2 = ThisDrawing.ModelSpace.AddArc(cpt2, leng / 4, dblAng, dblAng + PI)

Next
End Sub

 

Dear…

While thanking you for answering all my questions, I was wondering if you could help me more.

I want to propose my question again since your answer was not what I needed. The question is, we want the conical tank roof development and its relevant program. We are given the conical shape so we have all conical shape data.

 

Best regards

[fixo]

Are you so lazy to attach the picture here

instead of your wrong question?

I asked you in the post#4 to upload a picture

Sorry, but I'll go away from here,

you have do your work by yourself

[mehrdad]

Are you so lazy to attach the picture here

instead of your wrong question?

I asked you in the post#4 to upload a picture

Sorry, but I'll go away from here,

you have do your work by yourself

///////////////////////////////////////////////////////////

 

http://up.iranblog.com/images/jc4ckiaxekogtewo5lz.bmp

 

 

 

 

 

Dear fixo,

 

I do apologize for inconvenience, I didn't mean it and I am really in urgent need for finding the answer. I was wondering if you could help me as usual. Kindly find herewith the picture. Thanks in advance. To have a better view of this question kindly pay attention

to the attached file.

 

Best regards

[fixo]

Try this one

Hope it will get you started

See other things in the Help file

Option Explicit
Public Sub AddConePlate()
Dim Hc As Double
Hc = 100#
Hc = CDbl(InputBox(vbCrLf & "Enter a Height of cone: ", "Cone Parameters", 100#))
Dim Rad As Double
Rad = CDbl(InputBox(vbCrLf & "Enter a Radius of cone: ", "Cone Parameters", 50#))
Dim Pi
Pi = 4 * Atn(1#)
Dim gamma As Double
gamma = Atn(Hc / Rad)
Dim Rarc As Double
Rarc = Rad / Cos(gamma)
Dim beta As Double
beta = Rarc / Rad * 2 * Pi
Dim delta As Double
delta = (Pi * 2 - beta)
Dim cpt As Variant
cpt = ThisDrawing.Utility.GetPoint(, vbCrLf & "Specify a center point: ")
Dim spt As Variant
spt = ThisDrawing.Utility.PolarPoint(cpt, Pi * 1.5 + (delta / 2), Rarc)
Dim ept As Variant
ept = ThisDrawing.Utility.PolarPoint(cpt, Pi * 1.5 - (delta / 2), Rarc)
Dim oLine1  As AcadLine
Set oLine1 = ThisDrawing.ModelSpace.AddLine(cpt, ept)
Dim oLine2  As AcadLine
Set oLine2 = ThisDrawing.ModelSpace.AddLine(cpt, spt)
Dim oArc As AcadArc
Set oArc = ThisDrawing.ModelSpace.AddArc(cpt, Rarc, Pi * 1.5 - (delta / 2), Pi * 1.5 + (delta / 2))
'Test
Dim cone As Acad3DSolid
Set cone = ThisDrawing.ModelSpace.AddCone(cpt, Rad, Hc)
ThisDrawing.SendCommand ("-view swiso")
End Sub

I changed code now it will be OK for you

Edited December 18, 2011 by fixo

[mehrdad]

Try this one

Hope it will get you started

See other things in the Help file

Option Explicit
Public Sub AddConePlate()
Dim Hc As Double
Hc = 100#
Hc = CDbl(InputBox(vbCrLf & "Enter a Height of cone: ", "Cone Parameters", 100#))
Dim Rad As Double
Rad = CDbl(InputBox(vbCrLf & "Enter a Radius of cone: ", "Cone Parameters", 50#))
Dim Pi
Pi = 4 * Atn(1#)
Dim gamma As Double
gamma = Atn(Hc / Rad)
gamma = Pi / 2 - gamma
Dim Rarc As Double
Rarc = Rad / Cos(gamma)
Dim beta As Double
beta = Rarc / Rad * 360 / 180 * Pi
Dim delta As Double
delta = (Pi * 2 - beta)
Dim cpt As Variant
cpt = ThisDrawing.Utility.GetPoint(, vbCrLf & "Specify a center point: ")
Dim spt As Variant
spt = ThisDrawing.Utility.PolarPoint(cpt, Pi * 1.5 + (delta / 2), Rarc)
Dim ept As Variant
ept = ThisDrawing.Utility.PolarPoint(cpt, Pi * 1.5 - (delta / 2), Rarc)
Dim oLine1  As AcadLine
Set oLine1 = ThisDrawing.ModelSpace.AddLine(cpt, ept)
Dim oLine2  As AcadLine
Set oLine2 = ThisDrawing.ModelSpace.AddLine(cpt, spt)
Dim oArc As AcadArc
Set oArc = ThisDrawing.ModelSpace.AddArc(cpt, Rarc, Pi * 1.5 - (delta / 2), Pi * 1.5 + (delta / 2))
End Sub

 

I do appreciate and many thanks for your kind answer.

[fixo]

You're welcome,

[mehrdad]

You're welcome,

 

 

Hello

The latter formula is it possible that you write this?

ß = r / R * 360

I mean that the input data is large R and the small r, based on the formula to be solved

thank you

[fixo]

I'm not a math sorry

do it what you need