Multiple Copies

Multiple Copies

Anonymous
Not applicable
488 Views
8 Replies
Message 1 of 9

Multiple Copies

Anonymous
Not applicable
I wanted to create a COPY command where a user clicks on a LINE or ARC and makes multiple copies of that line.

It would be something like this:

1 User calls the command
2 User clicks on LINE or ARC
3 The command box will prompt how many copies to make
4 CAD makes needed copies and changes those copies to a different layer ("SUBLINE" or "SUBARC")

The copies should be coincident (right on top) of the original LINE or ARC. I've tried to do this using VB but I'm fairly new and I'm having trouble. Can anyone help?

Thanks in advance!

Bernard
0 Likes
489 Views
8 Replies
Replies (8)
Message 2 of 9

Anonymous
Not applicable
Like this?

[code]
Sub copyMuliple()
Dim oEnt As AcadEntity
Dim vPick As Variant
Dim oCopy As AcadEntity
Dim iNum As Integer
Dim I As Integer
Dim sLay As String

On Error GoTo Exit_Here
ThisDrawing.Utility.GetEntity oEnt, vPick, vbCr & "Select object to copy: "
iNum = ThisDrawing.Utility.GetInteger(vbCr & "Number of copies?: ")
sLay = oEnt.ObjectName
sLay = "SUB-" & Right(sLay, Len(sLay) - 4)
ThisDrawing.Layers.Add sLay
For I = 1 To iNum
Set oCopy = oEnt.Copy
oCopy.Layer = sLay
Next
Exit_Here:
End Sub
[/code]

wrote in message news:4859157@discussion.autodesk.com...
I wanted to create a COPY command where a user clicks on a LINE or ARC and
makes multiple copies of that line.

It would be something like this:

1 User calls the command
2 User clicks on LINE or ARC
3 The command box will prompt how many copies to make
4 CAD makes needed copies and changes those copies to a different layer
("SUBLINE" or "SUBARC")

The copies should be coincident (right on top) of the original LINE or ARC.
I've tried to do this using VB but I'm fairly new and I'm having trouble.
Can anyone help?

Thanks in advance!

Bernard
0 Likes
Message 3 of 9

Anonymous
Not applicable
not sure what you want for the layer stuff
but this will make the copies. Add some
error checking for missed selection and
such.

gl
Paul

'
Sub test()
Dim ent As AcadEntity
Dim pickpoint
Dim copyObj(0) As Object
Dim copy
Dim copies As Integer
Dim counter As Integer

With ThisDrawing

.Utility.GetEntity ent, pickpoint, "Select Object to copy:"

copies = InputBox("Enter number of copies:")
counter = copies

Do While counter > 0

Set copyObj(0) = ent

copy = ThisDrawing.CopyObjects(copyObj)
counter = counter - 1

Loop

End With
End Sub
'



wrote in message news:4859157@discussion.autodesk.com...
I wanted to create a COPY command where a user clicks on a LINE or ARC and
makes multiple copies of that line.

It would be something like this:

1 User calls the command
2 User clicks on LINE or ARC
3 The command box will prompt how many copies to make
4 CAD makes needed copies and changes those copies to a different layer
("SUBLINE" or "SUBARC")

The copies should be coincident (right on top) of the original LINE or ARC.
I've tried to do this using VB but I'm fairly new and I'm having trouble.
Can anyone help?

Thanks in advance!

Bernard
0 Likes
Message 4 of 9

Anonymous
Not applicable
in case you need to make multiple copies
of multiple objects..had to keep going...;)

'
Sub test()
Dim ent As AcadEntity
Dim ss As AcadSelectionSet
'ref microsoft scripting runtime
Dim dictObj As New Scripting.Dictionary
Dim copyObj() As Object
Dim copies As Integer
Dim counter As Integer
Dim i As Integer
Dim copy
Dim pickpoint
Dim keyObjs

With ThisDrawing
On Error Resume Next

.SelectionSets("SS").Delete
Set ss = .SelectionSets.Add("SS")

ss.SelectOnScreen

On Error GoTo myExit

If Not ss.Count <= 0 Then
For i = 0 To ss.Count - 1
dictObj.Add ss(i), i
Next i
Else: MsgBox "No Objects Selected:"
GoTo myExit
End If

keyObjs = dictObj.Keys

ReDim copyObj(UBound(keyObjs))

For i = LBound(keyObjs) To UBound(keyObjs)
Set copyObj(i) = keyObjs(i)
Next i

copies = InputBox("Enter number of copies:")
counter = copies

Do While counter > 0
copy = .CopyObjects(copyObj)
counter = counter - 1
Loop

End With
myExit:
On Error GoTo 0
Set dictObj = Nothing
ThisDrawing.SelectionSets("SS").Delete
Exit Sub
End Sub
'



"Paul Richardson" wrote in message
news:4859184@discussion.autodesk.com...
not sure what you want for the layer stuff
but this will make the copies. Add some
error checking for missed selection and
such.

gl
Paul

'
Sub test()
Dim ent As AcadEntity
Dim pickpoint
Dim copyObj(0) As Object
Dim copy
Dim copies As Integer
Dim counter As Integer

With ThisDrawing

.Utility.GetEntity ent, pickpoint, "Select Object to copy:"

copies = InputBox("Enter number of copies:")
counter = copies

Do While counter > 0

Set copyObj(0) = ent

copy = ThisDrawing.CopyObjects(copyObj)
counter = counter - 1

Loop

End With
End Sub
'



wrote in message news:4859157@discussion.autodesk.com...
I wanted to create a COPY command where a user clicks on a LINE or ARC and
makes multiple copies of that line.

It would be something like this:

1 User calls the command
2 User clicks on LINE or ARC
3 The command box will prompt how many copies to make
4 CAD makes needed copies and changes those copies to a different layer
("SUBLINE" or "SUBARC")

The copies should be coincident (right on top) of the original LINE or ARC.
I've tried to do this using VB but I'm fairly new and I'm having trouble.
Can anyone help?

Thanks in advance!

Bernard
0 Likes
Message 5 of 9

Anonymous
Not applicable
That works perfectly! This is what I'm tryin' to do: Let's say a LINE A intersects LINE B at any point except for the START/ENDPOINTS.

Instead of two lines there should be four lines now. All lines have the intersections point in common. Does this make sense. So with this command I guess I can make the copies and trim but it would be easer if it trimmed the copies as well.

Is this possible? Maybe with the intersectWith command? Cause I can't seem to make it work.

Bernard
0 Likes
Message 6 of 9

Anonymous
Not applicable
Hmmm, I'm a bit confused as to what you are trying to accomplish.....

If A & B intersect you want to create lines to show the individual segments?
Trim what?
What code have you tried but can't get to work?

A picture is worth a thousand words...... 😉


wrote in message news:4859271@discussion.autodesk.com...
That works perfectly! This is what I'm tryin' to do: Let's say a LINE A
intersects LINE B at any point except for the START/ENDPOINTS.

Instead of two lines there should be four lines now. All lines have the
intersections point in common. Does this make sense. So with this command I
guess I can make the copies and trim but it would be easer if it trimmed the
copies as well.

Is this possible? Maybe with the intersectWith command? Cause I can't seem
to make it work.

Bernard
0 Likes
Message 7 of 9

Anonymous
Not applicable
If LINE A intersects with LINE B instead of 2 LINES I want 4 LINES. 2 LINES that now make up LINE A and 2 LINES that now make line B. Note that all 4 LINES share a common point---the point of intersection.

What I'm having to do now is copying LINE A twice and trimming one side of LINE A for one line; and trimming the other side of LINE A for the other line.

What I would ideally like to accomplish is to highlight LINE A and it automatically breaks into two lines and deletes the original line. LINE A is broken wherever it is intersected by another LINE or ARC.

Also, in your previous macro when I pick a line object is there anyway to make it dashed so the user knows which entity he/she clicked. I forgot the line of code that does that.

Is this a better explanation? Thanks for all your help!

Bernard
0 Likes
Message 8 of 9

Anonymous
Not applicable
OK, that's what I thought you might be doing...........which really isn't
what you started out asking.

Now, do you want a function that will automatically break ALL lines/arcs
that intersect in a selection set? Since you are deleting the original
object, do you really want the new ones on a different layer?

For highlighting:
oEnt.Highlight True

wrote in message news:4859309@discussion.autodesk.com...
If LINE A intersects with LINE B instead of 2 LINES I want 4 LINES. 2 LINES
that now make up LINE A and 2 LINES that now make line B. Note that all 4
LINES share a common point---the point of intersection.

What I'm having to do now is copying LINE A twice and trimming one side of
LINE A for one line; and trimming the other side of LINE A for the other
line.

What I would ideally like to accomplish is to highlight LINE A and it
automatically breaks into two lines and deletes the original line. LINE A is
broken wherever it is intersected by another LINE or ARC.

Also, in your previous macro when I pick a line object is there anyway to
make it dashed so the user knows which entity he/she clicked. I forgot the
line of code that does that.

Is this a better explanation? Thanks for all your help!

Bernard
0 Likes
Message 9 of 9

Anonymous
Not applicable
oEnt.Highlight True works perfectly thanks again for all your help!

Now, EITHER a function that will automatically break ALL lines/arcs that intersect in a selection set OR have the user input each case where he wants a line broken down. That doesn't matter. BOTH would be ideal but if I'm given one I can figure out the other.

Also I would like the new ones on a different layer.

Thanks for you help and any source code that can accomplish this would be appreciated.

Bernard
0 Likes