no but why - message here, file moved

no but why - message here, file moved

Anonymous
Not applicable
219 Views
2 Replies
Message 1 of 3

no but why - message here, file moved

Anonymous
Not applicable
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
0 Likes
220 Views
2 Replies
Replies (2)
Message 2 of 3

Anonymous
Not applicable


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
0 Likes
Message 3 of 3

Anonymous
Not applicable
 


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
0 Likes