no but why - message here, file moved

[Anonymous]

The original of this message with attached file has been moved to
the Customer Files area at
news://discussion.autodesk.com/autodesk.autocad.customer-files or
http://discussion.autodesk.com/WebX?14@@.ee940b5. Please ZIP your
files if zipping will make them smaller. Zipping files (if it
saves space) is a courtesy to those who download the files.

GIFs, JPGs, or PNGs smaller than 200k only may now be posted in
all discussion groups.

See the newsgroup guidelines at
http://discussion.autodesk.com/webx?groundrules.
--
Anne Brown
Manager, Moderator
Autodesk Product Support discussion groups
Discussion Q&A: http://www.autodesk.com/discussion

======================
Subject:
no but why
Date:
Fri, 21 Nov 2003 04:27:25 -0800
From:
"youngman"
Organization:
sf
Newsgroups:
autodesk.autocad.customization.vba


hi,

here is my codes,
it runs well in some drawings,but fails in some other drawings.
the attached file is a no-sample.
could anybody tell me why.
thanks a lot in advance.


Sub DeleteScopeOnScreen()
' This example adds entities to a selection set by prompting
the user
' to select entities to add.
RESELECT:
Dim returnPnt1 As Variant
Dim returnPnt2 As Variant
Dim returnPnt3 As Variant
Dim returnPnt4 As Variant

returnPnt1 = ThisDrawing.Utility.GetPoint(, "Enter a point:
")
returnPnt2 = ThisDrawing.Utility.GetPoint(, "Enter a point:
")
returnPnt3 = ThisDrawing.Utility.GetPoint(, "Enter a point:
")
returnPnt4 = ThisDrawing.Utility.GetPoint(, "Enter a point:
")
Dim mode As Integer
Dim pointsArray(0 To 11) As Double
pointsArray(0) = returnPnt1(0): pointsArray(1) =
returnPnt1(1):
pointsArray(2) = 0
pointsArray(3) = returnPnt2(0): pointsArray(4) =
returnPnt2(1):
pointsArray(5) = 0
pointsArray(6) = returnPnt3(0): pointsArray(7) =
returnPnt3(1):
pointsArray(8) = 0
pointsArray(9) = returnPnt4(0): pointsArray(10) =
returnPnt4(1):
pointsArray(11) = 0
mode = acSelectionSetWindowPolygon

' Create the selection set
Dim ssetObj As AcadSelectionSet
Set ssetObj =
ThisDrawing.SelectionSets.Add("TEST_SSET$B#1#9(B11$B#1(B")
ssetObj.SelectByPolygon mode, pointsArray ', groupCode,
dataCode
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "OK" '
Style = vbYesNo + vbCritical + vbDefaultButton2 '
Title = "MsgBox "
Help = "DEMO.HLP" ' $B!#(B
Ctxt = 10000
'MsgBox ssetObj.Count
For Each obj In ssetObj
obj.Highlight (True)
Next
Update
Response = MsgBox(Msg, Style, Title, Help, Ctxt)

If Response = vbYes Then
MyString = "Yes" '
For Each obj In ssetObj
obj.Delete
Next
ssetObj.Delete
Else '
MyString = "No"
For Each obj In ssetObj
obj.Highlight (False)
Next
ssetObj.Delete
GoTo RESELECT
End If
End Sub 'OK


File: no but why.dwg

[Anonymous]

You need to make the world coordinate system active before using the GetPoint function.

Also consider using a loop construct rather than the GoTo keyword. It makes the code much easier to follow (IMHO).

Here's a revised version that works on the drawing you posted.

Sub DeleteScopeOnScreen()

  Dim continue As Boolean

  Dim currentUCS As AcadUCS

  Dim entity As AcadEntity

  Dim i As Integer

  Dim pickedPoint As Variant

  Dim pointsList(0 To 11) As Double

  Dim response As Integer

  Dim selectionSet As AcadSelectionSet

  

  Do

    continue = True

    

    ' Save the current UCS setting and activate the WCS.

    Set currentUCS = ThisDrawing.ActiveUCS

    ThisDrawing.SendCommand "UCS W "

    

    ' Get the four corners of a polygon from the user and store

    ' them in the points list array.

    For i = 0 To 9 Step 3

      pickedPoint = ThisDrawing.Utility.GetPoint(, "Enter a point: ")

      pointsList(i) = pickedPoint(0)

      pointsList(i + 1) = pickedPoint(1)

      pointsList(i + 2) = pickedPoint(2)

    Next i

    

    ' Delete the selection set named "TEST" if it already exists.

    For Each selectionSet In ThisDrawing.SelectionSets

      If selectionSet.Name = "TEST" Then

        selectionSet.Delete

        Exit For

      End If

    Next selectionSet

    

    ' Create a new selection set of all entities inside the polygon

    ' that the user defined.

    Set selectionSet = ThisDrawing.SelectionSets.Add("TEST")

    selectionSet.SelectByPolygon acSelectionSetWindowPolygon, pointsList

    selectionSet.Highlight True

    

    ' Restore the UCS setting

    ThisDrawing.ActiveUCS = currentUCS

    

    ' Delete the entities selected if the user is satified with the selection.

    response = MsgBox("Delete the selected entities?", vbYesNo)

    If response = vbYes Then

      For Each entity In selectionSet

        entity.Delete

      Next entity

      continue = False

    Else

      selectionSet.Highlight False

      continue = True

    End If

  Loop Until continue = False

End Sub

[Anonymous]

style="PADDING-RIGHT: 0px; PADDING-LEFT: 5px; MARGIN-LEFT: 5px; BORDER-LEFT: #000000 2px solid; MARGIN-RIGHT: 0px">

Thanks for your advice.

it realy helps me greatly,

thanks alot.

best
regards