×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

quick way to do offsets

quick way to do offsets

quick way to do offsets

(OP)
found this on another site

Option Explicit
Public Property Get Pi()
    Pi = 3.14159265358979
End Property

  


Private Sub AcadDocument_BeginDoubleClick(ByVal PickPoint As Variant)
    On Error GoTo Err_Control
  


Dim selectionSetObject As AcadSelectionSet
Dim objEnt As AcadEntity

    Set selectionSetObject = ThisDrawing.PickfirstSelectionSet
    If selectionSetObject.Count = 0 Then Exit Sub
    Set objEnt = selectionSetObject.Item(0)

  

With ThisDrawing.Utility
 Select Case objEnt.ObjectName
     Case "AcDbLine"
         Dim dblAng As Double
         Dim PolarPt1, polarPt2
         Dim dblOffset As Double
         Dim varStart As Variant
         Dim varEnd As Variant
         Dim VarPick As Variant
         Dim objXline As AcadXline
         Dim intSide As Integer
         Dim dblOffsetdata As Double
         
         dblOffsetdata = ThisDrawing.GetVariable("offsetdist")
         varStart = objEnt.StartPoint
         varEnd = objEnt.EndPoint
         dblOffset = .GetDistance(, vbCrLf & "<" & dblOffsetdata & ">" & "Offset distance: ")
         If dblOffset = 0 Then
             dblOffset = dblOffsetdata
         End If
     
         VarPick = .GetPoint(, "Specify point on side to offset:  ")
         intSide = SideOfLine(varStart, varEnd, VarPick)
         If intSide = -1 Then dblOffset = -dblOffset
         dblAng = ThisDrawing.Utility.AngleFromXAxis(varStart, varEnd) + 0.5 * Pi
         PolarPt1 = .PolarPoint(varStart, dblAng, dblOffset)
         polarPt2 = .PolarPoint(varEnd, dblAng, dblOffset)
         Set objXline = ThisDrawing.ModelSpace.AddXline(PolarPt1, polarPt2)
         ThisDrawing.SetVariable "offsetdist", Abs(dblOffset)
                       
                      
    Case "AcDbPolyline"
        Dim oLWP As AcadLWPolyline
        Dim dblangComp As Double
        Dim i As Integer, j As Integer
        Dim Coordinates As Variant
        Dim Coord As Variant
        Dim retAngle As Double
        Dim Point(2) As Double
        Dim CoordsCol As New Collection  'collections are arrays starting at 1 not 0
        Dim retAngles As New Collection
        Dim PrevV, NexV, LastVertex, Ptlist
        Dim dblAngle As Double
        
        objEnt.Highlight True
        Set oLWP = objEnt

        For i = 0 To (UBound(oLWP.Coordinates) - 1) / 2
            Coord = oLWP.Coordinate(i)
            ReDim Preserve Coord(2): Coord(2) = 0
            CoordsCol.Add Coord
        Next
        If oLWP.Closed = True Then
            CoordsCol.Add CoordsCol(1)
        End If
        For i = 1 To CoordsCol.Count - 1
            dblAngle = .AngleFromXAxis(CoordsCol(i), PickPoint) - .AngleFromXAxis(PickPoint, CoordsCol(i + 1))
            If dblAngle > Pi Then
                dblAngle = dblAngle - (2 * Pi) '180+->-180+
            ElseIf dblAngle < -Pi Then
                dblAngle = dblAngle + (2 * Pi) '-180+ ->180+
            End If
            If i = 1 Then
                dblangComp = dblAngle
                j = 1
            Else
                If Abs(dblAngle) < Abs(dblangComp) Then
                    dblangComp = dblAngle
                    j = i
                End If
            End If
        Next
        dblOffsetdata = ThisDrawing.GetVariable("offsetdist")
        varStart = CoordsCol(j): varEnd = CoordsCol(j + 1)
        On Error Resume Next
        dblOffset = .GetDistance(, vbCrLf & "<" & dblOffsetdata & ">" & "Offset distance: ")
        If dblOffset = 0 Then
           dblOffset = dblOffsetdata 'dblOffsetdata is the current offset in setvar
        End If
        On Error GoTo Err_Control
      
        VarPick = .GetPoint(, "Specify point on side to offset:  ")
        intSide = SideOfLine(varStart, varEnd, VarPick)
        If intSide = -1 Then dblOffset = -dblOffset
        dblAngle = ThisDrawing.Utility.AngleFromXAxis(varStart, varEnd) + 0.5 * Pi
        PolarPt1 = .PolarPoint(varStart, dblAngle, dblOffset)
        polarPt2 = .PolarPoint(varEnd, dblAngle, dblOffset)
        Set objXline = ThisDrawing.ModelSpace.AddXline(PolarPt1, polarPt2)
        ThisDrawing.SetVariable "offsetdist", Abs(dblOffset)
       
        objEnt.Highlight False
        
    

    End Select
    

    
    selectionSetObject.Highlight False
    selectionSetObject.Delete

End With

Exit_Here:
    Exit Sub
Err_Control:
    Select Case Err.Number
        Case "-2145320928"
            Resume Next
        'Case "13", "-2147467259", -2147352567 ', -2145320949 'Method 'Item' of object 'IAcadSelectionSet' failed
            'Dim varcancel
            'varcancel = ThisDrawing.GetVariable("LASTPROMPT")
            'If InStr(1, varcancel, "*Cancel*") <> 0 Then
        
                'If GetAsyncKeyState(VK_ESCAPE) And 8000 > 0 Then
                    'Err.Clear
                    'Resume Exit_Here
                    'ElseIf GetAsyncKeyState(VK_LBUTTON) > 0 Then
                    'Err.Clear
                    'Resume
                'End If
            'End If
        
           
        Case Else
        
        MsgBox Err.Description
        Err.Clear
        Resume Exit_Here
    End Select
  
End Sub

'SomeCallMeDave
'http://www.vbdesign.net/expresso/showthread.php?postid=57552#post57552
Public Function SideOfLine(LineStart As Variant, LineEnd As Variant, Pnt As Variant) As Integer
'returns -1 if Pnt is to left, +1 if Pnt is to right, 0 if all points are collinear
'return of 0 sometimes is inaccurate, due I think to rounding
On Error GoTo errcontrol
    Dim a1 As Double
    Dim a2 As Double
    Dim a3 As Double
    Dim a4 As Double
    
    a1 = LineStart(0) * LineEnd(1) - LineStart(0) * Pnt(1)
    a2 = -LineStart(1) * LineEnd(0) + LineStart(1) * Pnt(0)
    a3 = LineEnd(0) * Pnt(1) - LineEnd(1) * Pnt(0)
    
    a4 = a1 + a2 + a3
    
    If a4 = 0 Then SideOfLine = 0
    If a4 < 0 Then SideOfLine = -1
    If a4 > 0 Then SideOfLine = 1
Exit Function
errcontrol: MsgBox Err.Description
End Function


 

RE: quick way to do offsets

I'm not really fluent with lisp, so pardon my stupidity, but why is this so special?  Why not just hit "O", enter a distance, then select the object?

RE: quick way to do offsets

(OP)
we are new to autocad
so without knowing all the key commands
i thought it would be eaiser to just be able
to do a double click on a line and have it
preform the command

we use alot of construction lines for layout work
and this was one things the users asked about

RE: quick way to do offsets

DO YOURSELF A FAVOR.  GO TO THE HELP, IN THE INDEX SEARCH BOX TYPE "aliases, for commands, table listing of" IF YOU'RE AMBITIOUS AND HAVE A COUPLE OF SECONDS YOU CAN CUT AND PASTE THIS TABLE INTO EXCEL AND IT WILL FIT NICELY ON TWO SHEETS. IF YOU WANT GIVE MY YOUR FAX # AND I'LL FAX IT (CAN'T E-MAIL IT, CAUSE I DIDN'T FEEL THE NEED TO SAVE IT). PIN IT UP NEAR YOUR WORK STATION. THEN LEARN IT, LIVE IT, LOVE IT.  THE ICONS WILL CHANGE WITH EACH AUTO CAD VERSION, OR POTENTIALLY FORM STATION TO STATION, BUT KEYBOARD SHORT CUTS USUALLY ARE CONSISTENT.

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members!


Resources