Hi @norman.yuan , thank you for your messagge.
I'm little bit complicated on my project, however I guess I skipped the issue, adding to the VBA code a block definition without inserting (it was not my first idea, but seems the simply solution).
There is a procedure that could be applied on existing or new drawing, but of course need the availability of a specific block with an attribute. Block it's mainly composed by a point and related number (represented by the block attribute).
Of course in a new drawing there is any kind of block, so the procedure cannot insert a new block if not inside the drawing. So my first idea was the check of block inside the drawing, if not then open "insert" dialog for search the block as dwg stored somewhere in the computer, but seems more complicated.
So I tried to approach the creation of simply block definition, if not exist, and later I'll be able to insert as per mainly procedure require.
If could be useful for somebody below the code.
Private Sub BlockCheck()
'define variables
On Error Resume Next
Dim dblOrigin(0 To 2) As Double
Dim sysVarName As String
Dim sysVarData As Variant
Dim DataType As Integer
Dim intData As Integer
sysVarName = "PDMODE"
intData = 35
sysVarData = intData ' Integer data
ThisDrawing.SetVariable sysVarName, sysVarData
sysVarName = "PDSIZE"
intData = 1
sysVarData = intData ' Integer data
ThisDrawing.SetVariable sysVarName, sysVarData
Dim CurBlock As AcadBlock
Set CurBlock = ThisDrawing.Blocks.Item("MyPoint")
If Err <> 0 Then
Dim blockObj As AcadBlock
Dim var As String
var = "MyPoint"
Dim insertionPnt(0 To 2) As Double
insertionPnt(0) = 2
insertionPnt(1) = 2
insertionPnt(2) = 0
Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, var)
Dim AttributeObj As AcadAttribute
Dim height As Double
Dim mode As Long
Dim prompt As String
Dim tag As Variant
Dim value As String
height = 1
mode = acAttributeModeNormal
prompt = "POINT_NUMBER"
tag = "POINT"
value = "1"
Dim InsertionPoint(0 To 2) As Double
Dim MyPointObj As AcadPoint
InsertionPoint(0) = 0
InsertionPoint(1) = 0
InsertionPoint(2) = 0
Set MyPointObj = blockObj.AddPoint(InsertionPoint)
Dim BlockRefObj As AcadBlockReference
InsertionPoint(0) = 1.5
InsertionPoint(1) = 1.5
InsertionPoint(2) = 0
Set AttributeObj = blockObj.AddAttribute(height, mode, prompt, InsertionPoint, tag, value)
Dim insertionPt(0 To 2) As Double
'insertionPt(0) = 0
'insertionPt(1) = 0
'insertionPt(2) = 0
'Set BlockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPt, var, 1#, 1#, 1#, 0)
' MyAtt = BlockRefObj.GetAttributes
' MyAtt(0).Alignment = acAlignmentMiddleCenter
' MyAtt(0).InsertionPoint = InsertionPoint
' BlockRefObj.Delete
'ZoomExtents
'MsgBox "This Block represents " & var
End If
End Sub
Perhaps the code it's not perfect, it's coming from several cut and paste, but seems to solve my issue.
Thank you.
Bye
