Message 1 of 3
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi,
In a part of my current command i need to select a viewport to get te points of it, tramsform them to the model space an select all entities within the viewport area. The problem is that when i selected this viewport, the program get me inside of it and i don't know how to exist it.
after that, commnads like Editor.SwitchtoModelSpace() does not work.
I tried disposing the viewport or with using but neither they works.
Could somebody help me with this problem?
Probably it is trivial but I can't found the key of the problem.
My code is as follows:
Dim opt As PromptEntityOptions = New PromptEntityOptions("Pick a Viewport")
opt.SetRejectMessage("object must be a viewport")
opt.AddAllowedClass(GetType(Viewport), True)
Dim per As PromptEntityResult = ed.GetEntity(opt)
If per.Status <> PromptStatus.OK Then
ed.WriteMessage("Error intentando obtener el objeto seleccionado. Saliendo de la función.")
Return
End If
Dim PSVPpoints As Point3dCollection = New Point3dCollection
Dim MSVPpoints As Point3dCollection = New Point3dCollection
Using VP As Viewport = tr.GetObject(per.ObjectId, OpenMode.ForRead)
ed.WriteMessage("El número de puntos antes de obtener los de la viewport son {0}" + vbCrLf, PSVPpoints.Count)
VP.GetGripPoints(PSVPpoints, New IntegerCollection(), New IntegerCollection())
ed.WriteMessage("El número de puntos en la coleccion es : {0}" + vbCrLf, PSVPpoints.Count)
Dim tpm As Point3d = PSVPpoints(2)
PSVPpoints(2) = PSVPpoints(1)
PSVPpoints(1) = tpm
PSVPpoints.Remove(PSVPpoints(PSVPpoints.Count - 1))
Dim PSDSC2UCS = PSDCS2DCS(VP) * DCS2WCS(VP) * ed.CurrentUserCoordinateSystem
For Each pnt As Point3d In PSVPpoints
Dim point As Point3d
point = pnt.TransformBy(PSDSC2UCS)
MSVPpoints.Add(point)
ed.WriteMessage("Punto en PS: {0} Punto en MS: {1}" + vbCrLf, pnt, point)
Next
End Using
ed.WriteMessage("tenemos {0} puntos transladados al model space" + vbCrLf, MSVPpoints.Count)
ed.SwitchToModelSpace()
ed.WriteMessage("he cambiado al model space")
Dim acTypValAr(1) As TypedValue
acTypValAr.SetValue(New TypedValue(DxfCode.LayerName, "SE-Zz_2-E"), 0)
acTypValAr.SetValue(New TypedValue(DxfCode.Start, "MTEXT"), 1)
Dim acSelFtr As SelectionFilter = New SelectionFilter(acTypValAr)
Dim SelectionResult As PromptSelectionResult = ed.SelectCrossingPolygon(MSVPpoints, acSelFtr)
If SelectionResult.Status <> PromptStatus.OK Then
Return
End If
Dim SelectSet As SelectionSet = SelectionResult.Value
ed.WriteMessage("hemos seleccionado {0} entidades" + vbCrLf, SelectSet.Count)
Please, ignore all "ed.Writemessage()" as they are used for debbuging.
Solved! Go to Solution.