Type: sch to run macro.
On the userform choose "choose 2 points"
how to display the Y distance and X distance in textboxes ?
Something like:
Public Sub cmdPkt_S1_Click()
'With ThisDrawing.Utility
On Error Resume Next
schuf.Hide
On Error GoTo Koniec
ThisDrawing.SetVariable "OSMODE", 1 '' punkt
ThisDrawing.Utility.InitializeUserInput 1
pktaBaza01p = ThisDrawing.Utility.GetPoint(, "Wybierz 1 punkt")
If Err Then Exit Sub
On Error Resume Next
schuf.Hide
ThisDrawing.SetVariable "OSMODE", 1 '' punkt
ThisDrawing.Utility.InitializeUserInput 1
pktaBaza02p = ThisDrawing.Utility.GetCorner(pktaBaza01p, "Wybierz 2 punkt")
If Err Then Exit Sub
Dim wid As Double
wid = Abs(CDbl(pktaBaza01p(0) - pktaBaza02p(0)))
Dim hgt As Double
hgt = Abs(CDbl(pktaBaza01p(1) - pktaBaza02p(1)))
Dim b As String
b = CStr(wid)
Dim h As String
h = CStr(hgt)
Me.txtB.Text = b
Me.txtH.Text = h
Koniec:
schuf.Hide
Main01.Sch
' End With
End Sub
Here is just for form module changes
made for the quick test only
Sorry I haven't have so much time
to write for you whole project
Option Explicit
Private Sub lblgr_Click()
End Sub
Private Sub schuf_Initialize()
'kod wykonywany w chwili uruchomienia okna
Dim z As String
'txtH.Text = "a"
If odnschPod <> 0 Then
txtH.Text = ThisDrawing.odnschPodStr
End If
End Sub
Public Sub cmdPkt_S1_Click()
'With ThisDrawing.Utility
On Error Resume Next
schuf.Hide
On Error GoTo Koniec
ThisDrawing.SetVariable "OSMODE", 1 '' punkt
ThisDrawing.Utility.InitializeUserInput 1
pktaBaza01p = ThisDrawing.Utility.GetPoint(, "Wybierz 1 punkt")
If Err Then Exit Sub
On Error Resume Next
schuf.Hide
ThisDrawing.SetVariable "OSMODE", 1 '' punkt
ThisDrawing.Utility.InitializeUserInput 1
pktaBaza02p = ThisDrawing.Utility.GetPoint(pktaBaza01p, "Wybierz 2 punkt")
If Err Then Exit Sub
Dim wid As Double
wid = Abs(CDbl(pktaBaza02p(0) - pktaBaza01p(0)))
Dim txtWid As String
txtWid = CStr(wid)
Me.txtB.Text = txtWid
Dim hgt As Double
hgt = Abs(CDbl(pktaBaza02p(1) - pktaBaza01p(1)))
Dim txtHgt As String
txtHgt = CStr(hgt)
Me.txtH.Text = txtHgt
schuf.Show
' txtnsch = "text"
Koniec:
'commented for quick test :
'Main01.Sch
'Unload Me
' End With
End Sub
Private Sub txtnsch_Change()
If IsNumeric(txtnsch.Value) = True Then
Dim nsh As Integer
nsh = CInt(Me.txtnsch)
Dim ssh As Double
ssh = CDbl(Me.txtB) / nsh
Dim hsh As Double
hsh = CDbl(Me.txtH) / nsh
Me.txthsch.Text = CStr(hsh)
Me.txtssch.Text = CStr(ssh)
odNschodow = CInt(txtnsch.Value)
End If
End Sub
Just in addition
Do not add this line:
Unload Me
in the cmdOK button click
You can exit proejct from other button say cmdExit button
or from Main module at the end of Sub
Will be busy till 4-5 Jan.
Happy New Year