需要VBA和AutoCAD的建议

Robke · 发表于 2022-7-6 22:19:06

大家好，

我对这里和编程都是新手。我需要创建一个程序，应该检查图纸。检查的意思是，我们有3个不同的层：轮廓、轴和截面。正如你们所知，它们的线条粗细都不一样。
那么，让我们想象一下厚度应该是：0.5mm，1mm和2mm。

有没有可能创建这样一个程序，当用户选择图形中的任何线或任何层时，我的程序会检查此解决方案并自动更改层线的厚度？

如果是，我怎么做？有什么建议吗？

ReMark · 发表于 2022-7-6 22:27:09

您是否考虑过在AutoCAD中使用标准检查器功能。这可能会帮你节省一些工作。

Robke · 发表于 2022-7-6 22:36:58

谢谢你的建议，但我需要与*合作。dwg文件不是*。数据仓库
当我卸载时，我需要编写代码，检查选定的层或线，程序中的参数为0,5 1 2 mm，颜色为红绿和蓝色。
如果轮廓为红色，厚度为0.7，则存在问题。我的程序必须将厚度更改为0.5，并保留当前颜色。据我所知，所有的检查都必须在图层名上完成？不是吗？

ReMark · 发表于 2022-7-6 22:47:16

CHECKSTANDARDS命令可用于检查图形（DWG）是否存在冲突。然后可以自动、手动或忽略违规行为。

如果您想通过VBA编程实现这一点，请务必继续。也许这里的一位编程大师可以帮助你开始。

祝你的项目好运。

Robke · 发表于 2022-7-6 22:51:19

谢谢你的帮助。编程大师是我最后的希望。。。

BlackBox · 发表于 2022-7-6 23:01:19

登录/注册后可看大图

如果处理内部工作站，则可以使用反应器/事件处理程序来检测对层对象所做的更改，并以编程方式恢复所需的设置（这会让用户产生所做更改没有生效的错觉）。。。但是，由于您是编程新手，您应该重新访问标准命令选项methinks。

祝你好运

Robke · 发表于 2022-7-6 23:05:19

大家好，再来一次。。。。
我写了我的程序代码。。。现在我需要这样做：是否可以创建一个程序或smth，当用户单击autocad中的图形（我是指直线）或图层时，我的程序将启动？
现在，如果我启动宏（vba）并单击在窗体中创建的按钮，我的程序就会工作。。。我需要创建smth，我的程序将自动启动

Robke · 发表于 2022-7-6 23:12:35

大家好，
我有两个问题要问你。
这是我用于练习的简单VBA代码。我想问我做错了什么，因为然后我加载了一个*。dwg文件并运行宏，我总是得到Else语句。我不知道为什么。。。那么，我需要如何比较正确的字符串层名才能得到正确的if-elseif或else语句呢？
第二个问题是，在我选择autocad上的图层时，是否可以编写这样的程序自动运行？

copy

Private Sub CommandButton1_Click()
Dim strLayerKonturas As String
Dim strLayerAsys As String
Dim strLayerMatmenys As String
Dim objLayer As AcadLayer
Dim intColor As Integer
strLayerKonturas = "konturas"
strLayerAsys = "Asys"
strLayerMatmenys = "Matmenys"
'For Each objLayer In ThisDrawing.Layers
  If "" = strLayerKonturas Then ' exit if no name entered
       If objLayer.Color = acRed Xor objLayer.Linetype = "Continuous" Xor objLayer.Lineweight = acLnWt050 Then
         MsgBox "Sluoksnis: '" & objLayer.Name & "' tvarkoj"
         Else:
          objLayer.Color = acRed
         objLayer.Linetype = "Continuous"
         objLayer.Lineweight = acLnWt050
         objDrawingObject.Update
         MsgBox "Sluoksnis: '" & objLayer.Name & "' pertvarkytas"
       End If
         Else:
         MsgBox "Nera Konturo."
         End If
    
        
         
      
'   If "" = strLayerAsys Then 'Exit Sub ' exit if no name entered
        ' On Error Resume Next ' handle exceptions inline
  '       Set objLayer = ThisDrawing.Layers(strLayerAsys)
         
   '      If objLayer.Color = acGreen Xor objLayer.Linetype = "CENTER" Xor objLayer.Lineweight = acLnWt025 Then
     '    MsgBox "Sluoksnis: '" & objLayer.Name & "' tvarkoj"
    '     ElseIf objLayer.Color <> acGreen Xor objLayer.Linetype <> "CENTER" Xor objLayer.Lineweight <> acLnWt025 Then
      '       objLayer.Color = acGreen
       '      objLayer.Linetype = "CENTER"
        '     objLayer.Lineweight = acLnWt025
         '    MsgBox "Sluoksnis: '" & objLayer.Name & "' pertvarkytas"
          '    End If
           '  Else:       MsgBox "Nera asiu"
    ' End If
    
          
     '           If "" = strLayerMatmenys Then 'Exit Sub ' exit if no name entered
                 'On Error Resume Next ' handle exceptions inline
      '            Set objLayer = ThisDrawing.Layers(strLayerMatmenys)
       '                  If objLayer.Color = acBlue Xor objLayer.Linetype = "Continuous" Xor objLayer.Lineweight = acLnWtByLwDefault Then
        '                    MsgBox "Sluoksnis: '" & objLayer.Name & "' tvarkoj"
         '                ElseIf objLayer.Color <> acBlue Xor objLayer.Linetype <> "Continuous" Xor objLayer.Lineweight <> acLnWtByLwDefault Then
          '                 objLayer.Color = acBlue
           '                objLayer.Linetype = "Continuous"
                           
            '               objLayer.Lineweight = acLnWtByLwDefault
              ''             MsgBox "Sluoksnis: '" & objLayer.Name & "' pertvarkytas"
             '              End If
                ''           Else: MsgBox "ner gaidze"
   
       '' End If
        
        
        
 '      ElseIf ("" <> strLayerAsys) And ("" <> strLayerKonturas) And ("" <> strLayerMatmenys) Then
 '  MsgBox "Brezinyje privalo buti trys sluoksniai: Asys, Konturas, Matmenys. Prasome pertvarkyti brezini"
'End If
End Sub

btraemoore · 发表于 2022-7-6 23:25:43

我第一次学习vba时写了一些东西。附件是一个完整的项目，比较和更改zip中包含的文本文件中图层和线型的几种不同特性。请记住，这不是一个加载和运行。您将需要修改项目，但您可以查看语法并获得一些很好的示例，说明应该如何构造内容。祝你好运请记住，虽然autocad vba联机资源不多。。。谷歌是你最好的朋友。。。

干杯
vba自定义。拉链

[编程交流] 需要VBA和AutoCAD的建议

发表回复

精选推荐