Is the partref contained within the block? And is this 2000 or 2000i - I
know you put 2000, but, need to make sure. In 2000, you cannot embed a
partref consistantly - that is one of the reasons that they don't work with
custom parts. The only work around is to add the partref after you insert
the block. Below is a snippet of code that should get you started.
Sub addPartRef(strPartNumber, strPartDesc As String)
Dim acadapp As AcadApplication
Dim acutil As AcadUtility
Set acadapp = GetObject(, "AutoCAD.Application")
Set acutil = acadapp.ActiveDocument.Utility
Dim pt As Variant
pt = acutil.GetPoint(, "Location for ampartref: ")
pt = acutil.TranslateCoordinates(pt, acUCS, acWorld, False)
Dim mpartref As McadPartReference
Set mpartref = ThisDrawing.ModelSpace.AddCustomObject("AcmPartRef")
mpartref.Origin = pt
Dim symbb As McadSymbolBBMgr
Set symbb =
ThisDrawing.Application.GetInterfaceObject("SymBBAuto.McadSymbolBBMgr")
Dim bommgr As McadBOMMgr
Set bommgr = symbb.bommgr
'populate data
Dim pdata(0 To 1, 0 To 1) As String
pdata(0, 0) = "DESCR": pdata(0, 1) = strPartDesc
pdata(1, 0) = "PartNo": pdata(1, 1) = strPartNumber
'assign the data to ampartref
bommgr.setPartData mpartref, pdata
ThisDrawing.Application.Update
End Sub
"KDLA" wrote in message
news:f049477.-1@WebX.maYIadrTaRb...
I try to insert a block with a partref by vba code.
when I place the block with this code i can place a balloon with the
amballoon command
When I place the the same block a second time with this code then the
amballoon command fails. What can I do about it.
Public Sub test()
Dim blockprofiel As AcadBlockReference
Dim blockprofiel1 As AcadBlockReference
Dim block As AcadBlock
Dim profiel As String
Dim point(0 To 2) As Double
point(0) = 0
point(1) = 0
point(2) = 0
profiel = "t:\skywalloud\profielbm\swt120.dwg"
Set blockprofiel1 = ThisDrawing.ModelSpace.InsertBlock(point, profiel, 1#,
1#, 1#, 0)
ThisDrawing.Regen acAllViewports
End Sub
