Help on stretching my selected object

[Anonymous]

Hi guys. Sorry but i seem to be stuck once more.  I am writing a code to select an object (crossing) and to stretch it a certain distance on the y axis. This is the code that I have to select the object, but I cannot find what to use to stretch it.  I actually found something to scale it, but it is not what I need. Hope you guys can help. Thanks

With ThisDrawing.Utility
      

          Dim SP1sel1(0 To 2) As Double
          Dim SP1sel2(0 To 2) As Double

          Dim objSS As AcadSelectionSet

          
         Set objSS = ThisDrawing.SelectionSets.Add("zzadsaaafatt")
          
          ' Select the object
             SP1sel1(0) = 488: SP1sel1(1) = -20: SP1sel1(2) = 0
             SP1sel2(0) = 540: SP1sel2(1) = -150: SP1sel2(2) = 0
             objSS.Select acSelectionSetCrossing, SP1sel1, SP1sel2

Dim Test1 as AcadEntity

Dim StretchValue (0 To 2) As Double    ' this is the amount I would like to stretch by

StretchValue(0) = 0: StretchValue(1) = -30: StretchValue(2) = 0

Thanks for any help

[norman.yuan]

With code, you do not "Stretch" things as you do using AutoCAD as drafter. It depends on what entity you wna tot stretch:

For AcadLine, you must know which end (StartPoint or EndPoint) you want to stretch, then, you simply change start/end point to a new point. For polyline, you need to know which vertex you want to stretch, then you simply update the polyline's coordinates that define the vertices with one of the vertex being replaced by a new point. If it is a circle, stretch might mean to change its radius...

So, you would loop through the selectionset:

Dim ent As AcadEntity

For Each ent in objSS

    If TypeOf ent Is AcadLine Then

      ''Change line's start or end point

    ElseIf TypeOf ent Is AcadLWPolyline Then

      ''Update polyline's coordinates with a new vertex point

    ....

    ....

    End If

Next

[Anonymous]

Thanks for the reply.  I will give it a shot later today and I would appreciate any more help if I cannot get it to work,

Thanks,

[Hallex]

To stretch dynamically you might be want to use this one

Public Sub testStretch()
' keep left button when specify other corner
Dim comm As String
comm = "_stretch _c pause "
ThisDrawing.SendCommand comm

End Sub

~'J'~

[Anonymous]

Hey guys im sorry, but i just cannot figure this out.

I am looking at your comment

Dim ent As AcadEntity

For Each ent in objSS

    If TypeOf ent Is AcadLine Then

      ''Change line's start or end point

    ElseIf TypeOf ent Is AcadLWPolyline Then

      ''Update polyline's coordinates with a new vertex point

but how can I change the start or end point of the line when I have hand drawn it into autocad?  I havent declared any points.

I appreciate any responses

Thanks

[norman.yuan]

You, of course need to ask user to input the point he intends to stretch to, psudo code:

If Typeof ent Is AcadLine Then

   ''Ask user to input point, using AcadUtility.GetPoint()

   ''Change line's Start/End Point

End If

of course, with VBA, it is difficult for you to get dynamic visual feed back when user moves mouse to the intended stretch point (for point pick, it is fortunate enough that you can specify a base point so that a rubber line shows when trying to poick a point).

If you want to use the code to achieve the similar visual effect as built-in stretch command, you'd have to learn how to do it with Jig in ObjectARX (C++ or .NET API). Or do it with SendCommand(), as adviced by the other reply (note, with SendCommand(), you probably cannot loop through your selectionSet: SendCommand has to be the last line of code to execute.

[norman.yuan]

I just put some quick code that works:

Public Sub StretchEntity()

    Dim ss As AcadSelectionSet
    Set ss = ThisDrawing.SelectionSets.Add("MySS")
    ss.Select acSelectionSetAll
    
    Dim ent As AcadEntity
    Dim line As AcadLine
    
    For Each ent In ss
        If TypeOf ent Is AcadLine Then
            Set line = ent
            StretchLine line
        End If
    Next
    
    ss.Delete
    
End Sub

Private Sub StretchLine(line As AcadLine)

    Dim pt As Variant
    Dim basePt As Variant
    basePt = line.StartPoint
    
    pt = ThisDrawing.Utility.GetPoint(basePt, vbCr & "Stretch the line's end point to:")
    
    line.EndPoint = pt
    line.Update

End Sub

 As I said, the visual effect of strech is very limited due to the limitation of VBA in AutoCAD. There is nothing you can do about it.

[Anonymous]

Hrm, I guess I have to work my way around stretching, however I appreciate all of your help.