Question

关于CAD中VBA二次开发问题

我是初学者

Function loadlinetype(linetypename As String) As AcadLineType
' This example attempts to load the linetype "CENTER" from
' the acad.lin file. If the linetype already exists, then
' a message is displayed.

' Load "CENTER" line type from acad.lin file
' On Error Resume Next ' trap any load errors
loadlinetype= thisdrawing.Linetypes.load linetypename, "acad.lin"

'If the name already exists, then notify user
' If Err.Description = "Duplicate record name" Then
'MsgBox "A line type named '" & linetypename & "' already exists.", , "Load Example"
'End If

End Function

Sub pipe()
Dim lay1 As AcadLayer
Dim lay2 As AcadLayer
Set lay1 = ThisDrawing.Layers.Add("pipeside")
Set lay2 = ThisDrawing.Layers.Add("center")
lay1.color = acYellow
lay1.Linetype = "continuous"

lay2.Linetype = loadlinetype("Center")

End Sub
现在想通过函数来加载线型，执行到lay2.Linetype = loadlinetype("Center")
出现错误，求大神指导！

Answer 1

VBA没用过，不过从你的代码来看

lay1.Linetype = "continuous"  '这句正解，说明layer.Linetype为string类型
lay2.Linetype = loadlinetype("Center") 'loadlinetype返回类型为AcadLineType，扒禅所春好尘以类型袜岩不匹配

试试改为

ay1.Linetype = "continuous"
loadlinetype("Center")
lay2.Linetype = "Center"

追问

运行是对的，我还想问您一个问题，怎么用编程实现挡CAD打开时，所有线型自动加载

追答

不清楚啊，试试auto_open事件？在模块中放入以下代码

sub auto_open()
    loadlinetype("Center")
    loadlinetype("xxx")
end sub
Function loadlinetype(linetypename As String) As AcadLineType
end function

Answer 2

CAD钣金二次开发功能, 数冲与激光自动排版, 并统计材料毁闷费纤祥弯与喷涂费, 新功能在宴模不断完善及更新开发中...