АЛЕКСЕЙ ПОДСКАЖИТЕ ПОЖАЙЛУСТА ПОСЛЕДНИЙ РАЗ И БОЛЬШЕ Я К ВАМ НЕ БУДУ ПРИСТАВАТЬ С ГЛУПЫМИ ВОПРОСАМИ. ЧТО НЕ ТАК В КОДЕ??? ПОЧЕМУ НЕ ВСТАВЛЯЮТСЯ БЛОКИ??
ЛЮДИ, ЕСЛИ КТО ЗНАЕТ НАПИШИТЕ ПОЖАЙЛУСТА. С НЕТЕРПЕНЬЕМ ЖДУ!!!
Option Explicit
Public Function kpblc_CreateBlockByFormData(LabelText As String, _
Text1 As String, _
Text2 As String, _
Text3 As String) As _
AcadBlock
Dim BlockName As String
BlockName = LabelText & Text1 & Text2 & Text3
On Error GoTo lErrorGetRef
Set kpblc_CreateBlockByFormData = ThisDrawing.Blocks.Item(BlockName)
Exit Function
lErrorGetRef:
Dim oBlock As AcadBlock, PtOrigin(2) As Double
PtOrigin(0) = 0#: PtOrigin(1) = 0#: PtOrigin(2) = 0#
Set oBlock = ThisDrawing.Blocks.Add(PtOrigin, BlockName)
oBlock.AddCircle PtOrigin, 2.5
Set kpblc_CreateBlockByFormData = oBlock
End Function
Public Function kpblc_SetBlockName(ByRef frm As UserForm) As String
Dim sName As String
With frm
sName = Trim(.Label1.Caption) & Trim(.TextBox1.Text) & _
Trim(.TextBox2.Text) & Trim(.TextBox3.Text)
End With
kpblc_SetBlockName = sName
End Function
Option Explicit
Private Sub btnCancel_Click()
Unload Me
End Sub
Private Sub btnCopyToLabel_Click()
Me.Label1.Caption = Me.txtLabel.Text
SetInfo
SetOKState
End Sub
Private Sub btnOK_Click()
kpblc_CreateBlockByFormData Me.Label1.Caption, Me.TextBox1.Text, _
Me.TextBox2.Text, Me.TextBox3.Text
insertionPnt = ThisDrawing.Utility.GetPoint(, "Указать точку: ")
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, BlockName, 1#, 1#, 1#, 0, Rotation)
Unload Me
End Sub
Private Sub TextBox1_Change()
SetControlData Me.TextBox1
' SetInfo
' SetOKState
End Sub
Private Sub TextBox2_Change()
SetControlData Me.TextBox2
'SetInfo
'SetOKState
End Sub
Private Sub TextBox3_Change()
SetControlData Me.TextBox3
'SetInfo
'SetOKState
End Sub
Private Sub UserForm_Activate()
With Me
.Caption = "Создание блока по данным"
.Label1.Caption = ""
.txtLabel.Text = ""
.TextBox1.Text = ""
.TextBox2.Text = ""
.TextBox3.Text = ""
.btnOK.Enabled = False
End With
End Sub
Private Sub SetInfo()
Me.lblRes.Caption = kpblc_SetBlockName(Me)
End Sub
Private Sub SetOKState()
Me.btnOK.Enabled = (kpblc_SetBlockName(Me) <> "")
End Sub
Private Sub SetControlData(ByRef ctrl As TextBox)
ctrl.Text = Trim(ctrl.Text)
SetInfo
SetOKState
End Sub
