层是否存在？乐筑天下 - Powered by Discuz! Archiver

Bryco 发表于 2010-10-11 19:04:47

人民币锁。Layer=DoesLayerExist（RMLayer.name）
doeslayer需要返回字符串（Layername而不是acadlayer本身）

Bryco 发表于 2010-10-13 05:34:49

嗨，埃里克/布莱科，
我已经尝试了你的两个建议，但它就是不&#039；t改变块的层？本人&#039；m假设它在主命令按钮的子按钮或插入块的过程之前，所以它首先计算函数。我是这样想的，但我可以#039；如果我在下面发布我的全部代码（我可以&#039；我不会发布用户表单，但我&#039；相信你们可以想象得到lol）-哦，请原谅我的代码太粗糙了，我；我几乎是自学成才的，所以如果您有时间，任何关于干净代码的指针都将不胜感激：
Option Explicit
Dim response As Integer'Yes/No..
Dim BlockPoint As Variant 'First Insertion point..
Dim RMblock As AcadBlockReference 'Inserted Revision Marker block..
Dim AttribZ As Variant
Dim CountX As Integer 'Counter..
Dim RMlayer As AcadLayer
' FINISHED..
Private Sub FINISHEDbtn_Click()
Unload Me
End Sub
' HELP..
Private Sub HELPbtn_Click()
'Dim retval
'retval = Shell("C:\Program Files\Internet Explorer\IExplore.exe ""X:\CAD_Tools\Help\RM_help.html""", vbMaximizedFocus)
End Sub
Private Function DoesLayerExist() As AcadLayer
Dim LayerName As String
Dim objLayer As AcadLayer
LayerName = "LSC-REVISIONS_" & revnumCOMBO.Text

   For Each objLayer In ThisDrawing.Layers
         If UCase(objLayer.Name) = UCase(LayerName) Then
               DoesLayerExist = True
               RMlayer = objLayer
               MsgBox "Layer Does Exist: " & objLayer
               Exit Function
         End If
   Next objLayer

   DoesLayerExist = False
   MsgBox "Layer Does Not Exist: " & objLayer
   RMlayer = ThisDrawing.Layers.Add("LSC-REVISIONS_" & revnumCOMBO.Text)
   RMlayer.Plottable = False
End Function
'********************************************
'******** INSERT MARKERS ***********
'********************************************
Private Sub AddMArkersBTN_Click()
revmarkform.Hide
' Check if input is present..
If revnumCOMBO.Text = "" Then
MsgBox "Please enter or select the Revision Number..", vbExclamation, "Revision Markers.."
Exit Sub
End If
If revdateTXT.Text = "" Then
MsgBox "Please enter or select the revision date..", vbExclamation, "Revision Markers.."
Exit Sub
End If
'Get pick point..
'Error Test for GetPoint method..
On Error Resume Next
TryAgain:
BlockPoint = ThisDrawing.Utility.GetPoint(, vbCr & "Pick the first insertion point for the Revision Marker..")
'Insert block..
Set RMblock = ThisDrawing.PaperSpace.InsertBlock(BlockPoint, "P:\CAD_Blocks\PaperSpace Stuff\Program Blocks\Revision Marker.dwg", 1#, 1#, 1#, 0)
RMblock.Layer = DoesLayerExist(objLayer.Name)
AttribZ = RMblock.GetAttributes ' Get Block attributes..

For CountX = LBound(AttribZ) To UBound(AttribZ)
Select Case AttribZ(CountX).TagString
Case "REV_NUM_INDICATOR"
   AttribZ(CountX).TextString = UCase(revnumCOMBO.Text)
Case "COMMENTS_DATE"
   AttribZ(CountX).TextString = revdateTXT.Text
End Select
Next CountX
ErrHndlr:
If Err.Number0 Then
   If Err.Number = -2145320928 Then
         GoTo END_DO
   End If
   Err.Clear
   GoTo TryAgain
End If
On Error GoTo ErrHndlr
'*******************************
'** Start the point pick loop **
'*******************************
Do
CountX = CountX + 1'Add 1 to the counter..
' Error Test for GetPoint method..
'On Error Resume Next
TryAgain2:
BlockPoint = ThisDrawing.Utility.GetPoint(, vbCr & "Pick the insertion point for the next Revision Marker..")
'Insert block..
Set RMblock = ThisDrawing.PaperSpace.InsertBlock(BlockPoint, "P:\CAD_Blocks\PaperSpace Stuff\Program Blocks\Revision Marker.dwg", 1#, 1#, 1#, 0)
RMblock.Layer = DoesLayerExist(objLayer.Name)
AttribZ = RMblock.GetAttributes ' Get Block attributes..

For CountX = LBound(AttribZ) To UBound(AttribZ)
Select Case AttribZ(CountX).TagString
Case "REV_NUM_INDICATOR"
   AttribZ(CountX).TextString = UCase(revnumCOMBO.Text)
Case "COMMENTS_DATE"
   AttribZ(CountX).TextString = revdateTXT.Text
End Select
Next CountX
ErrHndlr2:
If Err.Number0 Then
   If Err.Number = -2145320928 Then
         GoTo END_DO
   End If
   Err.Clear
   GoTo TryAgain2
End If
'On Error GoTo ErrHndlr2
On Error GoTo END_DO 'Exit the loop if ENTER or another key is hit (basically an error)..

Loop
'*******************************
'******** End the loop *********
'*******************************
END_DO:
revmarkform.Show
End Sub
'********************************************
'******** INSERT MARKERS ***********
'********************************************
Private Sub revdateTXT_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
revdateTXT.Text = Format(Date, "DD/MM/YYYY")
End Sub
'********************************************
'*************** FORM LOAD ******************
'********************************************
Private Sub UserForm_Initialize()
ThisDrawing.ActiveSpace = acPaperSpace
With revnumCOMBO
.AddItem ("P2")
.AddItem ("P3")
.AddItem ("P4")
.AddItem ("P5")
.AddItem ("P6")
.AddItem ("P7")
.AddItem ("P8")
.AddItem ("P9")
.AddItem ("P10")
.AddItem ("C1")
.AddItem ("C2")
.AddItem ("C3")
.AddItem ("C4")
.AddItem ("C5")
.AddItem ("C6")
.AddItem ("C7")
.AddItem ("C8")
.AddItem ("C9")
.AddItem ("C10")
.AddItem ("AB")
End With
End Sub
'********************************************
'*************** FORM LOAD ******************
'********************************************
'********************************************
'*************** FORM UNLOAD ****************
'********************************************
Private Sub UserForm_QueryClose(Cancel As Integer, closemode As Integer)
response = MsgBox("Are you sure you've finished with the 'Revision Markers'?..", vbQuestion + vbYesNo, "End the Program..")
If response = vbNo Then
Cancel = 1
End If
If response = vbYes Then
   Unload Me
End If
End Sub
'********************************************
'*************** FORM UNLOAD ****************
'********************************************

Bryco 发表于 2010-10-13 08:32:36

私有函数DoesLayerExist（）作为字符串此函数必须返回字符串layername

Bryco 发表于 2010-10-13 09:06:23

您好，Bryco，我试过了（除了您显示的那行代码之外，没有更改其他代码），但它返回时说没有设置objLayer变量，即使它在函数中已设置。有什么想法吗？

Bryco 发表于 2010-10-13 10:23:58

这是一段模糊的记忆，所以我&#039；我会让你决定的；它有价值或毫无价值，但可能值得一试&nbsp；如果我没记错的话，用VBA制作层不会&#039；如果该层已经存在，则不会造成任何影响，因此您可以尝试取消检查功能，每次只创建该层&nbsp；除此之外，您可以在主sub中进行检查，而不是将其分解为函数；

页: 1 [2]

乐筑天下's Archiver