Nearest Point Using VBA

How to find the nearest point from the polyline or any object using visual Basic???

I tried hard but i can't find the answer...

can anybody help me on this??

How to find the nearest point from the polyline or any object using visual Basic???

 

I tried hard but i can't find the answer...

can anybody help me on this??

See here:

http://www.cadtutor.net/forum/showthread.php?t=46711

How to find the nearest point from the polyline or any object using visual Basic???

 

I tried hard but i can't find the answer...

can anybody help me on this??

Search Google VLAX.cls and Curve.cls

it may helps

~'J'~

Using Vlax.txt

See here:

http://www.cadtutor.net/forum/showthread.php?t=46711

Tanx for reply Kasra..

But wat i want is different...

In visual Basic..if i select a text it has to go to the nearest point automatically

Can u just help me with this:wink:

Search Google VLAX.cls and Curve.cls

it may helps

 

~'J'~

Tanx for reply Fixo..

i just want to know is there any possibility to place an arrow on poyline automatically depending on the value above or below the polyline..

Post a “before and after” drawing. That is usually the best illustration of a problem requiring automation.

Tanx for reply Fixo..

 

i just want to know is there any possibility to place an arrow on poyline automatically depending on the value above or below the polyline..

Not sure about I have understand you right,

just try the project

~'J'~

UsingVlax.zip

Not sure about I have understand you right,

just try the project

 

~'J'~

tanx for the project

Can u just tell me wat will the project u have sent will do...

And fixo...i want to tell u exactly wat i want to do...

I am having a value above or below the polyline... depending on the value above or below is positive...i want to place an arrow showing in direction using visual basic

Can u help with this pls.....

i only want the procedure to place an arrow exactly aligned to the polyline...

Pls help me Fixo

Is there any possibility to find at a particular point (means coordinate) wat type of autocad entity is present using vba

Is there any possibility to find at a particular point (means coordinate) wat type of autocad entity is present using vba

See post #6 from SEANT, please

~'J'~

See post #6 from SEANT, please

 

~'J'~

Sorry Fixo..i can't understand tat..

can u tell me wat does it mean

Sorry Fixo..i can't understand tat..

can u tell me wat does it mean

Attach the sample drawing with your valves, arrows and

pipeline here

Use 'Manage attachments' button below message window

Save dwg as A2007 (I'm using A2008)

~'J'~

Attach the sample drawing with your valves, arrows and

pipeline here

Use 'Manage attachments' button below message window

Save dwg as A2007 (I'm using A2008)

 

~'J'~

I have attached a File....in this one..i have to place arrows on the polyline taking into consideration the values on the line which are in blue color...

If u help with this..tat will be a great help for me

Drawing1.dwg

I have attached a File....in this one..i have to place arrows on the polyline taking into consideration the values on the line which are in blue color...

 

If u help with this..tat will be a great help for me

Much better

But this will keep me busy for a while

~'J'~

Much better

But this will keep me busy for a while

 

~'J'~

i got the idea to create an arrow depending upon the value dude...

But wat the thing i have to move tat arrow to the nearest polyline.....tat's wat where my problem is laying

If u help me with tat..it will help me a lot

i got the idea to create an arrow depending upon the value dude...

 

But wat the thing i have to move tat arrow to the nearest polyline.....tat's wat where my problem is laying

 

If u help me with tat..it will help me a lot

You did not show in the drawing where are your arrows, and

and what you want

And also there are no valves you talking about in there:x

It's a really big mess for me

In this case I can't help, sorry

Try to draw again what you have so far and what you want

to get after the program would be executed

As SEAN said attach "before and after" drawing instead

Hope it's clearly enough

~'J'~

You did not show in the drawing where are your arrows, and

and what you want

And also there are no valves you talking about in there:x

It's a really big mess for me

In this case I can't help, sorry

Try to draw again what you have so far and what you want

to get after the program would be executed

As SEAN said attach "before and after" drawing instead

Hope it's clearly enough

 

~'J'~

Sorry fixo....

Now i had made in the same way u wanted with before executing program and after executing program ..

Hope it is enough..ifnot tell me...i will prepare in which ever way u want...

tanx for help

Drawing1.dwg

Bhargav1987,

In the latest posted Drawing1.dwg, are the arrows on spans 278-279 and 279-280 actually pointing in the correct direction?

Bhargav1987,

 

In the latest posted Drawing1.dwg, are the arrows on spans 278-279 and 279-280 actually pointing in the correct direction?

Sorry Seant..ya it has to be reversed..

In a hurry i had made tat mistake

This may be a viable alternative to searching for the closest line. Run the routine with the attached file and window select the text entities.

Private Sub InsertArrow()
Dim fType(1) As Integer
Dim fData(1) As Variant
Dim entText As AcadText
Dim ent As AcadEntity
Dim dblValue As Double
Dim dblRotation As Double
Dim entInsert As AcadBlockReference

  fType(0) = 0: fData(0) = "TEXT"
  fType(1) = 62: fData(1) = 202
  If SoSSS(fType, fData) > 0 Then
     For Each entText In ThisDrawing.SelectionSets.Item("TempSSet")
        dblValue = ThisDrawing.Utility.DistanceToReal(entText.TextString, acDecimal)
        dblRotation = entText.Rotation
        If dblValue > 0 Then
            Set entInsert = ThisDrawing.ModelSpace.InsertBlock(entText.InsertionPoint, "ArrowPos", 1, 1, 1, dblRotation)
        Else
           Set entInsert = ThisDrawing.ModelSpace.InsertBlock(entText.InsertionPoint, "ArrowNeg", 1, 1, 1, dblRotation)
        End If
     Next
  End If
End Sub

Sub SSClear()
Dim SSS As AcadSelectionSets
  On Error Resume Next
  Set SSS = ThisDrawing.SelectionSets
     If SSS.Count > 0 Then
        SSS.Item("TempSSet").Delete
        SSS.Item("RemoveSSet").Delete
        SSS.Item("EntireSS").Delete
     End If
End Sub

Function SoSSS(Optional grpCode As Variant, Optional dataVal As Variant) As Integer
  Dim TempObjSS As AcadSelectionSet
  SSClear
  Set TempObjSS = ThisDrawing.SelectionSets.Add("TempSSet")
        'pick selection set
  If IsMissing(grpCode) Then
     TempObjSS.SelectOnScreen
  Else
     TempObjSS.SelectOnScreen grpCode, dataVal
  End If
  SoSSS = TempObjSS.Count
End Function

Drawing1WithBlocks.dwg