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
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
Norman Yuan
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,
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'~
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
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.
Norman Yuan
Hrm, I guess I have to work my way around stretching, however I appreciate all of your help.