oodelay Posted November 24, 2008 Posted November 24, 2008 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 Quote
ASMI Posted November 24, 2008 Posted November 24, 2008 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 Quote
oodelay Posted November 24, 2008 Author Posted November 24, 2008 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 Quote
BIGAL Posted November 26, 2008 Posted November 26, 2008 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 Quote
oodelay Posted November 26, 2008 Author Posted November 26, 2008 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! Quote
Recommended Posts
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.