houlinbo 发表于 2005-2-24 11:57:00

VBA线型加载问题

怎样防止线型的重复加载？对我来说很难，谢谢指教！

PS122 发表于 2005-2-24 12:43:00

Sub Example_Load()<BR>                       ' This example attempts to load the linetype "CENTER" from<BR>                       ' the acad.lin file. If the linetype already exists, then<BR>                       ' a message is displayed.<BR>                       <BR>                       Dim linetypeName As String<BR>                       linetypeName = "CENTER"<BR>                       <BR>                       ' Load "CENTER" line type from acad.lin file<BR>                       On Error Resume Next                       ' trap any load errors<BR>                       ThisDrawing.Linetypes.Load linetypeName, "acad.lin"<BR>                       <BR>                       ' If the name already exists, then notify user<BR>                       If Err.Description = "Duplicate record name" Then<BR>                                                       MsgBox "A line type named '" &amp; linetypeName &amp; "' already exists.", , "Load Example"<BR>                       End If<BR>                       <BR>End Sub

houlinbo 发表于 2005-2-24 20:59:00

可以加上说明吗？

PS122 发表于 2005-2-25 08:27:00

'符号后面的不是说明？老大，你编程吗？

winabcd 发表于 2005-2-25 09:44:00

2楼的，那个帮助文件中的程序例子你试过没有，运行结果与所给说明好象不一致，而且程序没有完善的出错处理。

mccad 发表于 2005-2-25 12:37:00

Sub Example_Load()
       ' 该示例尝试从acad.lin文件中加载 "CENTER" 线型。如果该线型已经存在，则显示提示。
      
       Dim linetypeName As String
       linetypeName = "center"
      
       ' 从acad.lin文件中加载 "CENTER"线型
       On Error Resume Next       ' 捕获任何出错信息
       ThisDrawing.Linetypes.Load linetypeName, "acad.lin"
      
       ' 如果该名称已经存在，则提醒用户
       If Err.Number = -2145386405 Then
               MsgBox "名称为“" & linetypeName & "”的线型已经存在。", , "明经通道VBA线型加载示例"
       End If
      
End Sub

houlinbo 发表于 2005-2-25 19:43:00

2楼的，你的程序行不通，麻烦你再和mccad老师的对比一下，同样谢谢你！

houlinbo 发表于 2005-2-25 19:44:00

感谢郑老师

fuday123 发表于 2005-5-12 11:03:00

''''各位老兄，看看下面的是否合适，以dashed线型为利


       


       


       


<BR>        Dim i As Integer<BR>        Dim dashedlineexist As Boolean       '''''判断是否存在的标志，如果存在，就激活为当前的线型，否则就添加该线型<BR>        <BR>        dashedlineexist = False       ''''先设定其不存在，如果存在就把它设成true<BR>        <BR>        <BR>        For i = 0 To ThisDrawing.Linetypes.Count - 1<BR>        If ThisDrawing.Linetypes.Item(i).Name = "DASHED" Then<BR>        ThisDrawing.ActiveLinetype = ThisDrawing.Linetypes.Item(i)<BR>        MsgBox "DASHED线型已经存在"<BR>        dashedlineexist = True<BR>        End If<BR>        Next i<BR>        <BR>        <BR>        If dashedlineexist = False Then ''''如果不存在就添加<BR>        <BR>        Dim dashedline As AcadLineType<BR>        ThisDrawing.Linetypes.Load "DASHED", "acad.lin"<BR>        Set dashedline = ThisDrawing.Linetypes.Item(ThisDrawing.Linetypes.Count - 1)       ''''找最后一个<BR>        <BR>        ThisDrawing.ActiveLinetype = dashedline


        End If<BR>        <BR>        <BR>

兰州人 发表于 2008-8-13 10:41:00

好帖，在判断图层和线性的装载时，用error比要比用循环实用。
页: [1] 2
查看完整版本: VBA线型加载问题