CADForums.net

Dave · Guest

I have several customers that are still using ACAD 2004. I have since added
several new utilities that when run, ACAD 2004's undo will not back up.

They are compiled referencing the ACAD 2004 runtime library.

Every one has these lines also"

Set AutoCAD_Application = AcadApp
Set Thisdrawing = AutoCAD_Application.ActiveDocument
Thisdrawing.StartUndoMark

code here

Thisdrawing.EndUndoMark
End Sub

Nothing seems to help.
Does anyone have any ideas or suggestions I could look for?

Thanks,
--
David Wishengrad
President & CTO
MillLister, Inc.
Software for BOM, measuring, stretching, feature recognition, and
controlling visibility of multiple 3D solids.
Http://Construction3D.com

Mike Tuersley · Guest

How are you handling errors and what is at "code here"? It's likely your
app leaves unexpectedly without hitting the EndUndoMark.

-- Mike
___________________________
Mike Tuersley
___________________________
the trick is to realize that there is no spoon...

Dave · Guest

Hi Mike,

This is one of many that fail:

Public Sub SLExplodec(AcadApp As AcadApplication)

Dim MinValue As Double
Dim MaxValue As Double
Dim MidValue As Double
Dim ssetObj As AcadSelectionSet
Dim ESolids() As typESolids
Dim Ent As AcadEntity
Dim NewSolid2 As Acad3DSolid
Dim NewBlock2 As AcadBlockReference
Dim x As Double, y As Double, z As Double
Dim minExt As Variant
Dim maxExt As Variant
Dim fromPoint(0 To 2) As Double
Dim movePt1(0 To 2) As Double
Dim returnPnt1 As Variant
Dim returnScale As String
Dim Cx As Double
Dim Cy As Double
Dim Cz As Double
Dim StringScaleAmount As Double
Dim LargestNumber As Double

Set AutoCAD_Application = AcadApp
Set thisdrawing = AutoCAD_Application.ActiveDocument
On Error Resume Next

thisdrawing.StartUndoMark

thisdrawing.SelectionSets("prev").Delete
Set ssetObj = thisdrawing.SelectionSets.Add("prev")
ssetObj.Select acSelectionSetPrevious

returnPnt1 = thisdrawing.Utility.GetPoint(, "Pick a point for the center
reference: ")
returnScale = thisdrawing.Utility.GetString(False, "Enter a numeric scale
amount (a space terminates input): ")

For Each Ent In ssetObj
If (Ent.ObjectName) = "AcDb3dSolid" Then
Set NewSolid2 = Ent

NewSolid2.GetBoundingBox minExt, maxExt

x = (Round(maxExt(0) - minExt(0), 6))
y = (Round(maxExt(1) - minExt(1), 6))
z = (Round(maxExt(2) - minExt(2), 6))

Cx = maxExt(0) - ((maxExt(0) - minExt(0)) / 2)
Cy = maxExt(1) - ((maxExt(1) - minExt(1)) / 2)
Cz = maxExt(2) - ((maxExt(2) - minExt(2)) / 2)

fromPoint(0) = Cx
fromPoint(1) = Cy
fromPoint(2) = Cz

StringScaleAmount = CDbl(returnScale)
movePt1(0) = Cx * StringScaleAmount
movePt1(1) = Cy * StringScaleAmount
movePt1(2) = Cz * StringScaleAmount
NewSolid2.Move fromPoint, movePt1

End If

If (Ent.ObjectName) = "AcDbBlockReference" Then
Set NewBlock2 = Ent

NewBlock2.GetBoundingBox minExt, maxExt

x = (Round(maxExt(0) - minExt(0), 6))
y = (Round(maxExt(1) - minExt(1), 6))
z = (Round(maxExt(2) - minExt(2), 6))

Cx = maxExt(0) - ((maxExt(0) - minExt(0)) / 2)
Cy = maxExt(1) - ((maxExt(1) - minExt(1)) / 2)
Cz = maxExt(2) - ((maxExt(2) - minExt(2)) / 2)

fromPoint(0) = Cx
fromPoint(1) = Cy
fromPoint(2) = Cz

StringScaleAmount = CDbl(returnScale)
movePt1(0) = Cx * StringScaleAmount
movePt1(1) = Cy * StringScaleAmount
movePt1(2) = Cz * StringScaleAmount
NewBlock2.Move fromPoint, movePt1

End If
Next
thisdrawing.EndUndoMark
End Sub

This code is copyright 2005 MillLister, Inc. All Rights Reserved.
If you wish to use this code, please contact MillIster, Inc. for a release.
We will be more then reasonable in handling your request.

Thanks Mike! I know you know your stuff. I really appreciate it.

--
David Wishengrad
President & CTO
MillLister, Inc.
Software for BOM, measuring, stretching, feature recognition, and
controlling visibility of
multiple 3D solids.
Http://Construction3D.com
"Mike Tuersley" <mtuersley_NOT_@rand.com> wrote in message
news:1l7qfe7881uo7$.wpfmi5pquw4o.dlg@40tude.net...

	CADForums.net Forum Index -> VBA	All times are GMT
Page 1 of 1