xdata/reactor length of lines

[enescil]

Dears,

I have a lot of lines that I need a length, like in attached file. At this moment I do it with a vba  that put fields in all lines.

The problems:

1) fields makes drawing slow to regen or after I modify line.

2) fields not follow lines slopes and position, if I stretch or move one end point of line. Text must be in middle of line.

So I thinking use reactors .

I tried reactor but I don't have much experience in lisp and I am having problems with persistent reactors, after I close file and open again, load lisp. Reactor not continue persistent. 

This is a test that I tried. Works only for one line.

(defun print-align-text ( owner reactor lst / sp ep a d )

(setq sp (vlax-curve-getstartpoint line1))
(setq ep (vlax-curve-getendpoint line1))
(setq a (angle sp ep))
(setq d (distance sp ep))
'(vla-put-textstring mytext (rtos d 2 0))
(vla-put-alignment mytext acalignmentbottomcenter)
(vla-put-textalignmentpoint mytext (vlax-3d-point (mapcar '/ (mapcar '+ sp ep) (list 2.0 2.0 2.0))))
(vla-put-rotation mytext a)

)

(defun c:pp ( / sp ep a d )
(vl-load-com)

(setq line1 (car (entsel "\nSelect line: ")))
(setq texto(car (entsel "\nSelect text: ")))

(setq sp (cdr (assoc 10 (entget line1))))
(setq ep (cdr (assoc 11 (entget line1))))

(setq line1 (vlax-ename->vla-object line1))
(setq mytext(vlax-ename->vla-object texto))

(setq a (angle sp ep))
(setq d (distance sp ep))

(vla-put-alignment mytext acalignmentbottomcenter)
(vla-put-textalignmentpoint mytext (vlax-3d-point (mapcar '/ (mapcar '+ sp ep) (list 2.0 2.0 2.0))))
(vla-put-rotation mytext a)

(setq myreactor (vlr-object-reactor (list line1) "Object Reactor : " '((:vlr-modified . print-align-text))))

(vlr-pers myreactor)

(princ)
)

I have read that is better store data using XData. But I have no idea to start.

In VBA I tried construct class module withevents, without any sucess.

My knowledge in VBA is basic.

Anyone could you give some directions to study best way to do it?

I can't use any kind of dimension.

Thanks

Claudio

[truss_85]

As a solution to your problems:

1) "fields makes drawing slow to regen or after I modify line" use UPDATEFIELD rather to REGEN. Because regen updates all fields in a drawing. UPDATEFIELD only updates specific fields that save a lot of time.

2) "fields not follow lines slopes and position, if I stretch or move one end point of line. Text must be in middle of line." use GEOMETRIC CONSTRAINTS to fix field to the line. _GcCoincident and _GcParallel do it what you wants.

Yes Storing data is better when you use XDATA but it is not a dynamic solution like field. You must run a code to store and another code to display. I am not recommend that solution to your situation. If you are insist to use XDATA, a code I inserted from VBA HELP.

Sub Example_SetXdata()
    ' This example creates a line and attaches extended data to that line.
    
    ' Create the line
    Dim lineObj As AcadLine
    Dim startPt(0 To 2) As Double, endPt(0 To 2) As Double
    startPt(0) = 1#: startPt(1) = 1#: startPt(2) = 0#
    endPt(0) = 5#: endPt(1) = 5#: endPt(2) = 0#
    Set lineObj = ThisDrawing.ModelSpace.AddLine(startPt, endPt)
    ZoomAll

    ' Initialize all the xdata values. Note that first data in the list should be
    ' application name and first datatype code should be 1001
    Dim DataType(0 To 9) As Integer
    Dim Data(0 To 9) As Variant
    Dim reals3(0 To 2) As Double
    Dim worldPos(0 To 2) As Double
    
    DataType(0) = 1001: Data(0) = "Test_Application"
    DataType(1) = 1000: Data(1) = "This is a test for xdata"

    DataType(2) = 1003: Data(2) = "0"                   ' layer
    DataType(3) = 1040: Data(3) = 1.23479137438413E+40  ' real
    DataType(4) = 1041: Data(4) = 1237324938            ' distance
    DataType(5) = 1070: Data(5) = 32767                 ' 16 bit Integer
    DataType(6) = 1071: Data(6) = 32767                 ' 32 bit Integer
    DataType(7) = 1042: Data(7) = 10                    ' scaleFactor

    reals3(0) = -2.95: reals3(1) = 100: reals3(2) = -20
    DataType(8) = 1010: Data(8) = reals3                ' real
    
    worldPos(0) = 4: worldPos(1) = 400.99999999: worldPos(2) = 2.798989
    DataType(9) = 1011: Data(9) = worldPos              ' world space position
    
    ' Attach the xdata to the line
    lineObj.SetXData DataType, Data
    
    ' Return the xdata for the line
    Dim xdataOut As Variant
    Dim xtypeOut As Variant
    lineObj.GetXData "", xtypeOut, xdataOut
    
End Sub

[enescil]

Dear Truss,

Thank you very much.

I will try before with fields.

I am using updatefield.

I set regenauto to off.

Drafters is complaining about.

Anyway Thanks

claudio

[Alfred.NESWADBA]

Hi,

>> fields not follow lines slopes and position, if I stretch or move one end point of line. Text must be in middle of line.

Can be done with constraints 😉

- alfred -

PS: rename the attached file to .DWG (I could not upload it directly with extension DWG)

[enescil]

Alfred,

Thanks.

Now I will implement in VBA.

[truss_85]

Look forward to it.

[enescil]

Hi,

I am trying to use sendcommand in my vba code.

To apply a constraint I need two clicks, in line and text. In my code this point has same coordinates.

Is there a way to filter in first point is to select line and in the second point in text?

ThisDrawing.SendCommand "_GcCoincident "

ThisDrawing.SendCommand x & "," & y & vbCr

ThisDrawing.SendCommand x & "," & y & vbCr 

error

The object or point is already selected. Select a different object or
constraint point.

Thanks

[truss_85]

I assumed that you add field to midpoint of the line. Add field slightly a diiferent coordinate then the midpoint and try again. If it does not work send whole of your code.

Best Regards... 

[enescil]

Dear Truss,
I implemented your suggestion. Sometimes works fine and sometimes not. I think that depend of zoom, text size and length of line.
Is there a way to use ObjectID using SendCommand?

[Alfred.NESWADBA]

Hi,

>> Sometimes works fine and sometimes not. I think that depend of zoom, text size and length of line

Correct! You can also see how the text-objects baseline get's highlighted depending on the position of your cursor (relative to the text object), that is needed for AutoCAD to know what point from the text is the point you need.

And that gives the explenation why you can't use just an ObjectID for a selection when using SendCommand with that commands. The object is not enough, you also need the point where the object is selected.

I guess you will not have luck doing that automatism with SendCommand. >>>this blog<<< gives some input/functions to go through constraints. Hopefully that will work for you.

If all fails you also have the option to create a dynamic block containing a line with a stretch-action on every line-endpoint + an attribute showing then the length of the line. So if it's to havy to create a line, then the field, then the constraints the insertion of that block might be the way to go?

Look to the attached sample, it's a (very) simple block with just one base-grip and two options to stretch to both sides. It depends on what you like to do, so it might be better to define the dynamic in another way, it's just a sample to show what I mean by block instead of each single object line+field+constraint to combine in runtime.

HTH, - alfred -

[truss_85]

Hi,

I agree with Alfred. Using a block more easy then line+field+constraint. But may be using a polar stretch parameter more like line charactaristics. Take a look attached block.

Best Regards...

[enescil]

Thanks for everyone. I understood questions.
This is only a part of my program, I have others functions that read fields of lines and construct other blocks attributes. I will try a little bit more with constraints.

[enescil]

Dear Truss,
I have a text field that read length of line. Do you known if is it possible access object ID of a field? Can I access ID of a line (inside Field).
If is possible I can do a command to re align all fields to lines.
My English is terrible.

[enescil]

I found a fieldcode function and a way to find objectid.
I think that is a fool question.
How can I select a object with object id that I found?

Public Sub alignfield()
Set objcad = ActiveDocument.Application
Set objmodel = objcad.ActiveDocument.ModelSpace()

On Error Resume Next
ThisDrawing.SelectionSets("teste").Delete
Set objmodel = ThisDrawing.SelectionSets.Add("teste")
objmodel.Clear
Dim f_type(0) As Integer
Dim f_data(0) As Variant
Dim ftype As Variant
Dim fdata As Variant

f_type(0) = 0
f_data(0) = "TEXT"

ftype = f_type
fdata = f_data

objmodel.SelectOnScreen ftype, fdata


For Each objent In objmodel

With objent
id = objent.FieldCode
If id <> "" Then id = Mid(id, 31, 13)
a = objmodel.HandleToObject(id) '???


End With
Next objent

End Sub

[truss_85]

If you use "handle to object" method your code must be like that:

Public Sub alignfield()

Dim ssetObj As AcadSelectionSet
Dim oText1 As AcadText
Dim oText2 As AcadText
On Error Resume Next
ThisDrawing.SelectionSets("teste").Delete
Set ssetObj = ThisDrawing.SelectionSets.Add("teste")

Dim f_type(0) As Integer
Dim f_data(0) As Variant

f_type(0) = 0
f_data(0) = "TEXT"

ThisDrawing.SelectOnScreen f_type, f_data

For Each Item In ssetObj
    Set oText1 = ssetObj.Item(n)
    ID = oText1.FieldCode
    'also you can get ID of an object like ID=oText1.ObjectID
    
    If ID <> "" Then ID = Mid(ID, 31, 13)
    handle_text1 = oText1.Handle
    
    Set oText2 = ThisDrawing.HandleToObject(handle_text1)
    'but we already select object as oText1 ? now we have same object on our hand oText1 and oText2

n = n + 1
Next

End Sub

I must do some corrections to your code. I can not know where do you use this module but I think handletoobject is not necessary. And if you use selection set why are you using "each object in modelspace" it is a conflict. I hope I understand your goal correctly.

Best Regards...

[enescil]

Truss,
Really thanks for your attention.
I will try to explain better, If my poor English allow.
In ID = Mid(ID, 31, 13, I get object id of line that field read. How can I get line object if I known object Id?

[enescil]

I tried code below, but a compile error appear: function or interface marked as restricted, or the function uses aa automation type not supported in visual basic.

For Each Item In ssetObj
Set oText1 = ssetObj.Item(n)
IDS = oText1.FieldCode
'also you can get ID of an object like ID=oText1.ObjectID
Dim objectID As Double
If IDS <> "" Then IDS = Mid(IDS, 31, 13)
objectID = CDbl(IDS)
Dim oline As AcadObject
oline = ThisDrawing.ObjectIdToObject(objectID)

'oline = Drawing.HandleToObject(objectID)

handle_text1 = oText1.Handle

Set oText2 = Drawing.HandleToObject(handle_text1)
'but we already select object as oText1 ? now we have same object on our hand oText1 and oText2

n = n + 1
Next

[enescil]

I correct to ObjectIdToObject32(objectID), error desapear but something continue wrong.

[truss_85]

Sorry for missunderstanding. Here it is the code:

Public Sub deneme()

Dim oEnt As AcadEntity
Dim oLine As AcadLine
Dim MtextObj As AcadMText
Dim pt As Variant

Dim FilterType(0) As Integer
Dim FilterData(0) As Variant
Dim ssetObj As AcadSelectionSet

On Error Resume Next
ThisDrawing.SelectionSets.Item("SS1").Delete
Set ssetObj = ThisDrawing.SelectionSets.Add("SS1")

FilterType(0) = 0
FilterData(0) = "LINE"

ssetObj.Select acSelectionSetAll, , , FilterType, FilterData

ThisDrawing.Utility.GetEntity oEnt, pt, "Select a Mtext:"
Set MtextObj = oEnt

ID_line = Mid(MtextObj.FieldCode, 31, 13)

n = 0
For Each Item In ssetObj
    Set oLine = ssetObj.Item(n)
    If ThisDrawing.Utility.GetObjectIdString(oLine, False) = ID_line Then
        'do what ever you want to do for example change the color or if you want to grap line I recommend handletoobject it never fails.
        oLine.color = acRed    
    End If
n = n + 1
Next

End Sub

 In field use Objectid not Objectid32 because of that your "ObjectIdToObject32(objectID)" does not work. Also "ObjectIdToObject32(objectID)" does not work either. I found a solution to get a selection set only lines and check out ids. It is not pretty but either two ways of above failed there is no option avaliable. Try it and let me know if it is working.

[enescil]

Dear Truss,

I made some changes to adapt to my code. It's working, Really thanks. 

But the problem is that, for each field, program has to read all lines, because of this program run slow. I put filters to try reduce quantity of elements and time to run.

Do you have any other suggestion to run more quickly?

Public Sub deneme()

Dim oEnt As AcadEntity
Dim oLine As AcadLine
Dim oField As AcadText
Dim pt As Variant

Dim FilterType(1) As Integer
Dim FilterData(1) As Variant
Dim ssetObj1 As AcadSelectionSet
Dim ssetObj2 As AcadSelectionSet

On Error Resume Next
ThisDrawing.SelectionSets.Item("SS1").Delete
Set ssetObj1 = ThisDrawing.SelectionSets.Add("SS1") 'lines

ThisDrawing.SelectionSets.Item("SS2").Delete
Set ssetObj2 = ThisDrawing.SelectionSets.Add("SS2") 'TEXTs with FIELD

FilterType(0) = 0
FilterData(0) = "LINE"
FilterType(1) = 8   '8 is layer
FilterData(1) = "5,c-5"

ssetObj1.Select acSelectionSetAll, , , FilterType, FilterData ' selection with lines filter

FilterType(0) = 0
FilterData(0) = "TEXT"
FilterType(1) = 8
FilterData(1) = "2,c-TEXTO"

ssetObj2.SelectOnScreen FilterType, FilterData 'selection with fields  

k = 0
For Each Item2 In ssetObj2
    Set oField = ssetObj2.Item(k) 'fields in drawing

    ID_line = Mid(oField.FieldCode, 31, 13)

    If ID_line <> "" Then
        n = 0
        For Each Item In ssetObj1
            Set oLine = ssetObj1.Item(n)
            If ThisDrawing.Utility.GetObjectIdString(oLine, False) = ID_line Then
                'do what ever you want to do for example change the color or if you want to grap line I recommend handletoobject it never fails.
                oLine.color = acRed
                'In this part I will manipulate field location with line information
            End If
        n = n + 1
        Next

    End If
k = k + 1
Next
End Sub