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"

[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

[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



<a href="http://up.iranblog.com/"><img src="http://up.iranblog.com/images/jc4ckiaxekogtewo5lz.bmp" border="0" alt="سایت آپلود عکس و آپلود سنتر فایل ایران بلاگ" /></a>



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