Measuring the Distance

Hi,

Is it possible to write a VBA to get the value of the measurement of an
object (by using the Distance command ) then pass it through a message box
?Thanks,

Afshin.

 

Its possible, but you're better off sticking with straight vb rather than
mixing acad commands.


Public Sub Distance()
'Replacement for Distance command.
Dim Point1 As Variant
Dim Point2 As Variant

Point1 = ThisDrawing.Utility.GetPoint(, "Select first Point.")
Point2 = ThisDrawing.Utility.GetPoint(, "Select second Point.")
MsgBox "The distance is " &
ThisDrawing.Utility.RealToString(XYZDistance(Point1, Point2),
acDefaultUnits, 3)

End Sub

Public Function XYZDistance(Point1 As Variant, Point2 As Variant) As Double
On Error GoTo Err_Control
'Returns the distance between two points
Dim dblDist As Double
Dim dblXSl As Double
Dim dblYSl As Double
Dim dblZSl As Double
Dim varErr As Variant
'Calc distance
dblXSl = (Point1(0) - Point2(0)) ^ 2
dblYSl = (Point1(1) - Point2(1)) ^ 2
dblZSl = (Point1(2) - Point2(2)) ^ 2
dblDist = Sqr(dblXSl + dblYSl + dblZSl)
'Return Distance
XYZDistance = dblDist

Exit_Here:
Exit Function
Err_Control:
Select Case Err.Number
'Add your Case selections here
Case Else
MsgBox Err.Number & ", " & Err.Description, , "XYZDistance"
Err.Clear
Resume Exit_Here
End Select
End Function

 

Thank you so much Ed.

 

Ed,

Here is gives me an error when I try to run it:

MsgBox "The distance is " &
ThisDrawing.Utility.RealToString(XYZDistance(Point1, Point2),
acDefaultUnits, 3)

Do you know how I can fix it ? Thanks.

 

What kind of error? Be more specific.

 

A wild guess: watch out for word wrap...

 

Yes, if you added the code into your ide as shown in the ng, it wouldn't
even compile, but show in red. The MsgBox statement is on 3 lines here. It
should all be on one line in your ide.

 

I got it thank you so much.

 

You're welcome. ;-)

--
----
Ed
----

 

Ed, I have asked this question from some expert on Excel , but I haven't
received any answer yet , I thought you might help me with this as well
,please see below ,this is the copy of my question that I have sent them, as
I mentioned its about VBA on Excel.

Thanks in advance.
Afshin

================================================

I have downloaded some Excel files to lean about how other programmer are
writing their codes , these files are protected by password ,I already
removed them from my hard drive but when I open any new or existing excel
files they are already loaded in the VBA editor (as a XLA !) ,when I try to
delete them
they are asking for the password . please tell me:
1- How I can delete them?
2- How I can find or disable the password ?

=================================================

 

Do a search in Explorer for *.xla. Those files work like acad.dvb and are
automatically loaded when xl starts. Be careful of what you're deleting!
Some xla's ship with xl and are part of xl's core functionality. Are you
sure that those are the ones you downloaded?

 

Thanks Ed,
That was it,I have moved them to new folder and now they are not active any
more. Yes I am sure that they came from those files that I have downloaded.
Thanks again.
Afshin

 

Ed,

I have one more question please, The value of the length that I am getting
from message box from codes below ,is it possible to apply that number to a
text (or Mtext) which is already in the drawing by clicking over that text ?
Thanks,

Afshin.

 

assuming you have the text object you want to set...
Textobject.TextString = ThisDrawing.Utility.RealToString(XYZDistance(Point1,
Point2), acDefaultUnits, 3)

 

Sure, just select the text and set its TextString property with the value.

 

[pre]
Public Sub Distance2()
Dim Dist As String
Dim Entity As AcadEntity
Dim FilterData(0 To 3) As Variant
Dim FilterType(0 To 3) As Integer
Dim Point1 As Variant
Dim Point2 As Variant
Dim SelectionSet As AcadSelectionSet

' Calculate the distance between any two points.
Point1 = ThisDrawing.Utility.GetPoint(, "Select first Point.")
Point2 = ThisDrawing.Utility.GetPoint(, "Select second Point.")
Dist = ThisDrawing.Utility.RealToString(XYZDistance(Point1, Point2), _
acDefaultUnits, 3)

' Delete selection set "SS0" if it already exists
For Each SelectionSet In ThisDrawing.SelectionSets
If SelectionSet.Name = "SS0" Then
SelectionSet.Delete
End If
Next SelectionSet

' Create a new selection set named "SS0"
Set SelectionSet = ThisDrawing.SelectionSets.Add("SS0")

' Define the type of entities to filter on when selecting items.
FilterType(0) = -4
FilterData(0) = "<or"
FilterType(1) = 0
FilterData(1) = "TEXT"
FilterType(2) = 0
FilterData(2) = "MTEXT"
FilterType(3) = -4
FilterData(3) = "or>"

' User selects a text entity to update.
ThisDrawing.Utility.Prompt "Select text entity to update." & vbCrLf
SelectionSet.SelectOnScreen FilterType, FilterData

' Update the text entity.
If SelectionSet.Count > 0 Then
For Each Entity In SelectionSet
Entity.TextString = Dist
Next Entity
End If

' Delete the selection set.
SelectionSet.Delete
End Sub
[/pre]

 

Ed,

I have one more question please, The value of the length that I am getting
from message box from codes below ,is it possible to apply that number to a
text (or Mtext) which is already in the drawing by clicking over that text ?
Thanks,

Afshin.

 

Sorry I sent it twice,(Outlook express problem !) anyway thanks for all the
answers.

Afshin.

 

OE, is that Outlook Express or Operator Error? ;-)