Jump to content

Recommended Posts

Posted

Private Sub GetPlais_Click()

Dim tmpnt1 As Variant, tmpnt2 As Variant, tmpPnt1 As Variant

Dim lole(0 To 2) As Double, upri(0 To 2) As Double

Dim returnobj As AcadObject

FrmGrid3.Hide

On Error GoTo Eline

ThisDrawing.Utility.GetEntity returnobj, tmpPnt1, "ÅðÝëåîå ôï ViewPort ðïõ èá äçìéïõñãçèåß ï êÜíáâïò!"

If TypeOf returnobj Is IAcadPViewport Then

Set viewportObj = returnobj

viewportObj.UCSIconOn = True

viewportObj.UCSIconAtOrigin = True

viewportObj.Display True

Scal = 1000 / viewportObj.CustomScale '= 1000 / CDbl(cbScale.Text)

 

Else

MsgBox "ÄÝí åðÝëåîåò ViewPort!!!", vbOKOnly, "Ó÷åäßáóç êáíÜâïõ"

FrmGrid3.Show

Exit Sub

End If

lole(0) = viewportObj.Center(0) - viewportObj.Width / 2

lole(1) = viewportObj.Center(1) - viewportObj.Height / 2

upri(0) = viewportObj.Center(0) + viewportObj.Width / 2

upri(1) = viewportObj.Center(1) + viewportObj.Height / 2

PntUpLPap(0) = lole(0): PntDoLPap(0) = lole(0): PntUpRPap(0) = upri(0): PntDoRPap(0) = upri(0)

PntUpLPap(1) = upri(1): PntDoLPap(1) = lole(1): PntUpRPap(1) = upri(1): PntDoRPap(1) = lole(1)

tmpnt1 = ThisDrawing.Utility.TranslateCoordinates(lole, acPaperSpaceDCS, acDisplayDCS, False)

tmpnt1 = ThisDrawing.Utility.TranslateCoordinates(tmpnt1, acDisplayDCS, acWorld, False)

TxtDoLX.Text = Format(tmpnt1(0), "0.##0"): PntDoLmod(0) = tmpnt1(0)

TxtDoLY.Text = Format(tmpnt1(1), "0.##0"): PntDoLmod(1) = tmpnt1(1)

tmpnt1 = ThisDrawing.Utility.TranslateCoordinates(upri, acPaperSpaceDCS, acDisplayDCS, False)

tmpnt1 = ThisDrawing.Utility.TranslateCoordinates(tmpnt1, acDisplayDCS, acWorld, False)

TxtUpRX.Text = Format(tmpnt1(0), "0.##0"): PntUpRmod(0) = tmpnt1(0)

TxtUpRY.Text = Format(tmpnt1(1), "0.##0"): PntUpRmod(1) = tmpnt1(1)

tmpnt1(0) = lole(0)

tmpnt1(1) = upri(1)

tmpnt1 = ThisDrawing.Utility.TranslateCoordinates(tmpnt1, acPaperSpaceDCS, acDisplayDCS, False)

tmpnt1 = ThisDrawing.Utility.TranslateCoordinates(tmpnt1, acDisplayDCS, acWorld, False)

TxtUpLX.Text = Format(tmpnt1(0), "0.##0"): PntUpLmod(0) = tmpnt1(0)

TxtUpLY.Text = Format(tmpnt1(1), "0.##0"): PntUpLmod(1) = tmpnt1(1)

tmpnt1(0) = upri(0)

tmpnt1(1) = lole(1)

tmpnt1 = ThisDrawing.Utility.TranslateCoordinates(tmpnt1, acPaperSpaceDCS, acDisplayDCS, False)

tmpnt1 = ThisDrawing.Utility.TranslateCoordinates(tmpnt1, acDisplayDCS, acWorld, False)

TxtDoRX.Text = Format(tmpnt1(0), "0.##0"): PntDoRmod(1) = tmpnt1(0)

TxtDoRY.Text = Format(tmpnt1(1), "0.##0"): PntDoRmod(1) = tmpnt1(1)

 

Eline:

FrmGrid3.Show

End Sub

I can't understand the problem!!!!

Posted

You should rework your project or give all the modules code...

 

Private Sub GetPlais_Click()
   'you have to dim these as open arrays, SEE OPEN ARRAY below
   Dim tmpnt1() As Variant
  ' where is this one??
   Dim tmpPnt1 As Variant
   ' YOUR NOT USING THIS ONE AT ALL
   tmpnt2 As Variant
   
   Dim lole(0 To 2) As Double, upri(0 To 2) As Double
   Dim returnobj As AcadObject
   FrmGrid3.Hide
   On Error GoTo Eline
   ThisDrawing.Utility.GetEntity returnobj, tmpPnt1, "ÅðÝëåîå ôï ViewPort ðïõ èá äçìéïõñãçèåß ï êÜíáâïò!"
   If TypeOf returnobj Is IAcadPViewport Then
       Set viewportObj = returnobj
       viewportObj.UCSIconOn = True
       viewportObj.UCSIconAtOrigin = True
       viewportObj.Display True
       Scal = 1000 / viewportObj.CustomScale '= 1000 / CDbl(cbScale.Text)
   Else
       MsgBox "ÄÝí åðÝëåîåò ViewPort!!!", vbOKOnly, "Ó÷åäßáóç êáíÜâïõ"
       FrmGrid3.Show
       Exit Sub
   End If
   
   lole(0) = viewportObj.Center(0) - viewportObj.Width / 2
   lole(1) = viewportObj.Center(1) - viewportObj.Height / 2
   
   upri(0) = viewportObj.Center(0) + viewportObj.Width / 2
   upri(1) = viewportObj.Center(1) + viewportObj.Height / 2
   
   ' ARE THESE GLOBAL?
   PntUpLPap(0) = lole(0): PntDoLPap(0) = lole(0): PntUpRPap(0) = upri(0): PntDoRPap(0) = upri(0)
   PntUpLPap(1) = upri(1): PntDoLPap(1) = lole(1): PntUpRPap(1) = upri(1): PntDoRPap(1) = lole(1)
   
   tmpnt1 = ThisDrawing.Utility.TranslateCoordinates(lole, acPaperSpaceDCS, acDisplayDCS, False)
   tmpnt1 = ThisDrawing.Utility.TranslateCoordinates(tmpnt1, acDisplayDCS, acWorld, False)
   
   TxtDoLX.Text = Format(tmpnt1(0), "0.##0"): PntDoLmod(0) = tmpnt1(0)
   TxtDoLY.Text = Format(tmpnt1(1), "0.##0"): PntDoLmod(1) = tmpnt1(1)
   
   tmpnt1 = ThisDrawing.Utility.TranslateCoordinates(upri, acPaperSpaceDCS, acDisplayDCS, False)
   tmpnt1 = ThisDrawing.Utility.TranslateCoordinates(tmpnt1, acDisplayDCS, acWorld, False)
   
   TxtUpRX.Text = Format(tmpnt1(0), "0.##0"): PntUpRmod(0) = tmpnt1(0)
   TxtUpRY.Text = Format(tmpnt1(1), "0.##0"): PntUpRmod(1) = tmpnt1(1)
   
   ' OPEN ARRAY:
   tmpnt1(0) = lole(0)
   tmpnt1(1) = upri(1)
   
   tmpnt1 = ThisDrawing.Utility.TranslateCoordinates(tmpnt1, acPaperSpaceDCS, acDisplayDCS, False)
   tmpnt1 = ThisDrawing.Utility.TranslateCoordinates(tmpnt1, acDisplayDCS, acWorld, False)
   
   TxtUpLX.Text = Format(tmpnt1(0), "0.##0"): PntUpLmod(0) = tmpnt1(0)
   TxtUpLY.Text = Format(tmpnt1(1), "0.##0"): PntUpLmod(1) = tmpnt1(1)
   
   tmpnt1(0) = upri(0)
   tmpnt1(1) = lole(1)
   
   tmpnt1 = ThisDrawing.Utility.TranslateCoordinates(tmpnt1, acPaperSpaceDCS, acDisplayDCS, False)
   tmpnt1 = ThisDrawing.Utility.TranslateCoordinates(tmpnt1, acDisplayDCS, acWorld, False)
   
   TxtDoRX.Text = Format(tmpnt1(0), "0.##0"): PntDoRmod(1) = tmpnt1(0)
   TxtDoRY.Text = Format(tmpnt1(1), "0.##0"): PntDoRmod(1) = tmpnt1(1)

Eline:
FrmGrid3.Show
End Sub
I can 't understand the problem!!!!

Posted

Whats the probelm ? please describe

 

 Dim tmpPnt1 As Variant, tmpnt2 As Variant
   ' YOUR NOT USING THIS ONE AT ALL
  

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...