AfraLisp Blog

The AutoLisp/Visual Lisp/VBA Resource Website

AfraLisp Blog

Home Newsletter Utter Rubbish Coding Tips AutoCAD Tips Contact Downloads WAUN

Muliple Offset.

This application will offset an entity multiple times. Just select the entity, enter an offset distance, (enter a negative number if you want to offset the other way), and then enter the number of times you would like to offset it.
Enter this coding into a new module : 

Option Explicit


Public Sub Moffset()
Dim objPicked As Object
Dim BasePnt As AcadPoint
Dim returnDist As Double
Dim nuOffsets As Integer
Dim i As Integer
Dim accumDist As Double
Dim offsetObj As Variant
'declare variables

ThisDrawing.Utility.GetEntity objPicked, BasePnt, "Select A Line"
'select the object

returnDist = ThisDrawing.Utility.GetDistance(, "Enter distance: ")
'get the distance to offset

nuOffsets = ThisDrawing.Utility.GetInteger("Number of Offsets : ")
'get the number of offsets

offsetObj = objPicked.Offset(returnDist)
'offset the object

For i = 1 To nuOffsets
'set up the loop

accumDist = returnDist + accumDist
'calculate the new offset distance

offsetObj = objPicked.Offset(accumDist)
'multiple offset the object

Next i
'loop

End Sub 

Now run the macro 'Moffset'. Works fine Hey!. Now run it again but this time select an empty space on the screen when prompted to select an object.
Oh, Crikey, an error??? Re-run it once more but this time select an object.
Now press the Escape key. Oh No, another error!!!

I think this application is screaming out for some error control.
Start a new application and enter this coding. I've colour coded the coding that
has been added : 

Option Explicit

Public Const VK_ESCAPE = &H1B
Declare Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Long) As Integer


Function checkkey(lngKey As Long) As Boolean If GetAsyncKeyState(lngKey) Then checkkey = True Else checkkey = False End If End Function
Public Sub Moffset1() Dim objPicked As Object Dim BasePnt As AcadPoint Dim returnDist As Double Dim nuOffsets As Integer Dim i As Integer Dim accumDist As Double Dim offsetObj As Variant 'declare variables Start: On Error GoTo errControl 'if there is an error ThisDrawing.Utility.GetEntity objPicked, BasePnt, "Select A Line" 'select the object returnDist = ThisDrawing.Utility.GetDistance(, "Enter distance: ") 'get the distance to offset nuOffsets = ThisDrawing.Utility.GetInteger("Number of Offsets : ") 'get the number of offsets offsetObj = objPicked.Offset(returnDist) 'offset the object For i = 1 To nuOffsets 'set up the loop accumDist = returnDist + accumDist 'calculate the new offset distance offsetObj = objPicked.Offset(accumDist) 'multiple offset the object Next i 'loop Exit Sub 'exit the sub routine errControl: 'define the error control If Err.Description = "Method 'GetEntity' of object _ 'IAcadUtility' failed" Then 'if the error matches these.. If checkkey(VK_ESCAPE) = True Then 'if the escape key is selected End 'end Else 'or else Resume 'repeat "Select Object" End If Else MsgBox Err.Description 'it must be another type of error End If End Sub

 


Now load and run Macro 'Moffset1'. Much better, Hey? 
Thanks to Randall Raath for the error checking in this application. 
If you would like to download the source code for this Application/s, Then click Here
 
The AutoLisp/Visual Lisp/VBA Resource Website

Copyright 1999-Perpetuity by AfraLisp

All rights reserved.
Information in this document is subject to change without notice.
Site created and maintained by Kenny Ramage

The AutoLisp/Visual Lisp/VBA Resource Website