# Thread: Help with VBA & AutoCAD- placing an arc through existing lines

1. ## Help with VBA & AutoCAD- placing an arc through existing lines

Hello, I am new to this forum but I was pleased to see all the AutoCAD experts here!! I need some help with somthing I can not do on my own.

I have parts with small line segments that form an arc, I need to offset these inwards .12" then erase the old line segments. I have a ton of these to do and I need a fast way to do it so its a perfect project for VBA.

What I presently do now is to put a 3 point arc through the line segments, then offset this arc to .12" then I erase all the line segments. There is more to it but this is where I would like to start. The parts are like half donuts and I offset both sides on each part, then I trim the new arc at the ends.

Thanks for any help with this.

Rob

2. Hi,
welcome on board

This code will draw an arc inside your
lines chain at distance 0.12 from these lines
Is there what you want?
Let me know how it will works

~'J'~

```
Option Explicit

Public Function Get_Distance(fPoint As Variant, sPoint As Variant) As Double
Dim x1 As Double, x2 As Double
Dim y1 As Double, y2 As Double
Dim z1 As Double, z2 As Double
Dim cDist As Double
x1 = fPoint(0): y1 = fPoint(1): z1 = fPoint(2)
x2 = sPoint(0): y2 = sPoint(1): z2 = sPoint(2)
cDist = Sqr(((x2 - x1) ^ 2) + ((y2 - y1) ^ 2) + ((z2 - z1) ^ 2))
Get_Distance = cDist
End Function

Public Function Get_MidPoint(fPoint As Variant, sPoint As Variant) As Variant
Dim mpoint(2) As Double
mpoint(0) = (CDbl(sPoint(0)) + CDbl(fPoint(0))) / 2
mpoint(1) = (CDbl(sPoint(1)) + CDbl(fPoint(1))) / 2
mpoint(2) = (CDbl(sPoint(2)) + CDbl(fPoint(2))) / 2
Get_MidPoint = mpoint
End Function

Sub OffsetLinesToArc()
Dim pt1 As Variant
Dim pt2 As Variant
Dim pt3 As Variant
Dim pt4 As Variant
Dim pt5 As Variant
Dim pt6 As Variant
Dim pt7 As Variant
Dim pt8 As Variant
Dim ang1 As Double
Dim ang2 As Double
Dim stAng As Double
Dim endAng As Double
Dim osm As Integer, varpt As Variant
Dim Pi As Double
Pi = Atn(1#) * 4
osm = ThisDrawing.GetVariable("OSMODE")
ThisDrawing.SetVariable "OSMODE", 1
MsgBox "First select line then" & vbCr & _
"Pick points in" & vbCr & _
"clockwise order only!"

On Error GoTo Err_Control
With ThisDrawing.Utility

.GetEntity oEnt, varpt, vbCr & "Select any of lines from the chain"
If TypeOf oEnt Is AcadLine Then
Set oLine = oEnt
Else
Exit Sub
End If

pt1 = .GetPoint(, vbCr & "Specify the starting point of an arc in clockwise order")
pt2 = .GetPoint(pt1, vbCr & "Specify the point near to middle of the chain of lines")
pt3 = .GetPoint(pt2, vbCr & "Specify the ending point")
ang1 = .AngleFromXAxis(pt1, pt2) + (Pi / 2)
ang2 = .AngleFromXAxis(pt2, pt3) + (Pi / 2)
pt4 = Get_MidPoint(pt1, pt2)
pt5 = Get_MidPoint(pt2, pt3)
pt6 = .PolarPoint(pt4, ang1, 1#)
pt7 = .PolarPoint(pt5, ang2, 1#)
End With
ThisDrawing.SetVariable "OSMODE", 0
Dim intPt As Variant
intPt = oXline1.IntersectWith(oXline2, acExtendNone)
dblRad = Get_Distance(intPt, pt1) - 0.12
With ThisDrawing.Utility
stAng = .AngleFromXAxis(intPt, pt3)
endAng = .AngleFromXAxis(intPt, pt1)
End With
oArc.Layer = oLine.Layer
oArc.Linetype = oLine.Linetype
oArc.LinetypeScale = oLine.LinetypeScale
oArc.Lineweight = oLine.Lineweight
oArc.TrueColor = oLine.TrueColor
oArc.Update
Exit_Here:
oXline1.Delete
oXline2.Delete
ThisDrawing.SetVariable "OSMODE", osm
Exit Sub
Err_Control:
MsgBox Err.Description
Resume Exit_Here
End Sub```

3. This one will offset just lines
Tested on 2007 only

```
Option Explicit
Public Sub OffsetLines()
Dim oEnt
Dim fcode(0) As Integer
Dim fData(0) As Variant
Dim dxfcode, dxfdata
Dim i As Integer
Dim setName As String
' build filter
fcode(0) = 0     ' entity code
fData(0) = "LINE"     ' entity data type
dxfcode = fcode
dxfdata = fData
setName = "\$Lines\$"     ' selection set name
On Error GoTo Err_Control
'Make sure named selection set does not exist
' if this does exist then delete it
For i = 0 To ThisDrawing.SelectionSets.Count - 1
If ThisDrawing.SelectionSets.Item(i).Name = setName Then
ThisDrawing.SelectionSets.Item(i).Delete
Exit For
End If
Next i
' create new selection set
' select all lines on screen by window or by picking one by one
oSset.SelectOnScreen dxfcode, dxfdata
'//MsgBox "Selected " & oSset.Count & " lines"     ' debug only
Dim offdist As String
offdist = CStr(InputBox(vbCr & "Enter offset distance" & _
"Press Enter to default", "Offset Distance", "0.12"))
Dim offPt As Variant
offPt = ThisDrawing.Utility.GetPoint(, vbCr & "Pick point on side to offset")
Dim strPt As String
strPt = Replace(CStr(offPt(0)), ",", ".") & "," & Replace(CStr(offPt(1)), ",", ".")
'Process each line
Dim lnstPt As String
For Each oEnt In oSset
Set oLine = oEnt
lnstPt = Replace(CStr(oLine.StartPoint(0)), ",", ".") & "," & Replace(CStr(oLine.StartPoint(1)), ",", ".")
ThisDrawing.SendCommand "offset" & Chr(10) & offdist & Chr(10) & lnstPt & Chr(10) & strPt & Chr(10)
Next oEnt
' end all commands
SendKeys "{ENTER}"
DoEvents
Exit_Here:
' delete all parent lines
oSset.Delete
' clean up (optional)
Set oSset = Nothing
Exit Sub
Err_Control:
MsgBox Err.Description
Resume Exit_Here
End Sub```
~'J'~

4. Originally Posted by Fatty
Hi,
welcome on board

This code will draw an arc inside your
lines chain at distance 0.12 from these lines
Is there what you want?
Let me know how it will works

~'J'~
Thanks for the welcome!

Fatty........where in the world did you learn to write code like that!? Very nice indeed.

I can use it, and it worked in 2000 for me, the second one got an error but on Moday I will test it again at work on 2005.

5. Hi
another good source for Acad users is here:
http://discussion.autodesk.com/forum.jspa?forumID=33
What about my programmer level in fact it's
very weak, trust me
I am just hacked some codes from many places
and gathered in once, nothing else
The same as with my english level as you guess
About second code it's used 'SendCommand' method, that is
working often instabilly, I have to use it rarely by this reason

~'J~

6. Nice link too bad that forum isn't PHP though, its hard on the eyes. Well I will be arround here more hoping to get better with VBA programing for AutoCAD. Its hard to get help with this stuff lots of people don't like to share code.

Thanks again, Rob

7. Hi Rob

Here are a lot of peoples who
can help too, don't forget about

Happy computing

~'J'~

8. dears
i hope to fined some vba code about intersectwith of any object to 3dface.

can u help me about that?

9. Hi J:

I was re-visiting this code and I would like to tweak it just a tad and add a variable to the arc offset called myoffset. I would also like to see this asked at the command line.

How can I do that?

[VBA]Dim myoffset As Double
'myoffset = vbCr & "Specify the offset" <-- on the command line
'dblRad = Get_Distance(intPt, pt1) - 0.12
dblRad = Get_Distance(intPt, pt1) - myoffset[/VBA]

P.S. Was your screen name Fatty before??

10. Wait, I did it through a example here from Lucas (see code) but now I think what I would like to do is specify if I wan't the offset inside or outside, and the new offset line to be on layer 78 any idea on this?

Edit/Update: I Just figured out how to change the layer to 78 and the offset!

Thanks!
Rob

Dim myoffset As Double
'dblRad = Get_Distance(intPt, pt1) - 0.12
Prompt1 = vbCrLf & "offset (Inches)<" & Format(myoffsets, "0.0000") & ">: "
'store the prompt
myoffset = ThisDrawing.Utility.GetReal(Prompt1)
'get the Slot Length in inches
'get the length if it is 0 then set it to the saved last length
If myoffset = 0 Then
'saved length entered
myoffset = myoffsets
Else
'save the number entered
myoffsets = myoffset
End If

dblRad = Get_Distance(intPt, pt1) - myoffset
[/vba]

#### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•