Jump to content

Recommended Posts

Posted

Hello,

I'm looking via lisp or simple macro commands a way to select block A and extract the attribute value named ELEV1 and then select block B and insert the value as ELEV2 (all my blocks have the ELEV1 and ELEV2 attributes).This would be used between different blocks, so the command HAS to search for the ELEV1 attribute (it's not always in the same ATT order).

I've played a bit with a few commands and got lost with the Attributes inside a block.

 

I hope it's as simple as it sounds.

 

Thanks,

Oodelay

Posted
I'm looking via lisp or simple macro commands a way to select block A and extract the attribute value named ELEV1 and then select block B and insert the value as ELEV2 (all my blocks have the ELEV1 and ELEV2 attributes).

 

It's not too hard. But maybe simply click first attribute, than click second? Look here: http://www.asmitools.com/Files/Lisps/Ttc.html

Posted

Thanks!!!

That sure helped me lots but I would like it to *always* be from elev1 to elev2 just on clicking on the block, wherever I click.

.

I can already save lots of time!

Thanks again,

Oodelay

Posted

Can be done search here for attribute under VBA I do something like this where I pick text or a block and then update another block.

 

here is some code which almost does what you want just needs a few lines removed and added. The main thing is that a block with attributes starts with a zero next is 1 2 3 etc Attrib(0) is the first attribute don't worry about tag names etc Almost forgot block2 here is "SCHEDTXT"

 

Public Sub ModifyPitSchedule1()
' adds single pt
Dim SS As AcadSelectionSet
Dim objENT As AcadEntity
Dim Count, Cntr As Integer
Dim Newpitname As String
Dim pitname As String
Dim FilterDXFCode(0) As Integer
Dim FilterDXFVal(0) As Variant
Dim PitNameSelect As AcadObject
Dim basepnt, pt1, pt2, pt3 As Variant
Dim attribs As Variant
'On Error Resume Next
Newpitname = "1"   'dummy to pass then return changed
BLOCK_NAME = "SCHEDTEXT"
pitname = Getpitname(Newpitname)
MsgBox "pitname selected is " & pitname
FilterDXFCode(0) = 0
FilterDXFVal(0) = "INSERT"
'FilterDXFCode(1) = 2
'FilterDXFVal(1) = "SCHEDTEXT"
Set SS = ThisDrawing.SelectionSets.Add("pit1sel")
SS.Select acSelectionSetAll, , , FilterDXFCode, FilterDXFVal

For Cntr = 0 To SS.Count - 1
If SS.Item(Cntr).Name = BLOCK_NAME Then

  attribs = SS.Item(Cntr).GetAttributes

    If attribs(0).TextString = pitname Then
      pt1 = ThisDrawing.Utility.GetPoint(, " pick first point")
      txtx1 = CStr(FormatNumber(pt1(0), 3))
      TXTY1 = CStr(FormatNumber(pt1(1), 3))

       attribs(1).TextString = txtx1
       attribs(2).TextString = TXTY1

       attribs(1).Update
       attribs(2).Update
'        ThisDrawing.Application.Update
' try this
       Cntr = SS.Count

    Else: End If

Else: End If
Next Cntr
ThisDrawing.SelectionSets.Item("pit1sel").Delete
End Sub
Function Getpitname(Newpitname As String) As String
Dim PitNameSelect As AcadObject
Dim pitattribs As Variant

ThisDrawing.Utility.GetEntity PitNameSelect, basepnt, "pick pit name : "
If PitNameSelect.ObjectName = "AcDbText" Then
 Getpitname = PitNameSelect.TextString
End If
If PitNameSelect.ObjectName = "AcDbBlockReference" Then
 pitblname = PitNameSelect.Name   ' RETURNS BLOCK NAME
 pitattribs = PitNameSelect.GetAttributes
 Getpitname = pitattribs(0).TextString
End If

End Function

Posted

WoW!

 

Thank you very much for this quick response, I Will do my

best to provide support also here as best as I can, I'm quite

familliar with civil 3D.

 

Thanks again!

:shock:

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...