兰州人 发表于 2008-12-30 09:17:00

图层的线型定义

<p>线型加载程序</p><p>&nbsp;&nbsp;&nbsp; Dim linetypeName As String<br/>&nbsp;&nbsp;&nbsp; linetypeName = "center"<br/>&nbsp;&nbsp;&nbsp;<br/>&nbsp;&nbsp;&nbsp; ' 从acad.lin文件中加载 "CENTER"线型<br/>&nbsp;&nbsp;&nbsp; On Error Resume Next&nbsp;&nbsp;&nbsp; ' 捕获任何出错信息<br/>&nbsp;&nbsp;&nbsp; ThisDrawing.Linetypes.Load linetypeName, "acad.lin"<br/>&nbsp;&nbsp;&nbsp;<br/>&nbsp;&nbsp;&nbsp; ' 如果该名称已经存在，则提醒用户<br/>&nbsp;&nbsp;&nbsp; If Err.Number = -2145386405 Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MsgBox "名称为“" &amp; linetypeName &amp; "”的线型已经存在。", , "明经通道VBA线型加载示例"<br/>&nbsp;&nbsp;&nbsp; End If<br/>现在的问题是将线型加载到图层，程序不通过。</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set objLayer = .Layers.Item(jj)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; With objLayer<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Select Case objLayerArray(jj)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Case "中心线"<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .Linetype = "Center"<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Case "虚线"<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .Layers.Linetypes = "Dashed"<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End Select<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End With<br/>从理论讲是可行的，但实际操作，程序不通过，原因何在？？？</p>

黄玉宏 发表于 2009-1-2 14:39:00

<p>&nbsp;Select Case objLayerArray(jj)应修改为 Select Case objLayerArray(jj).Name</p><p>再试试　</p><p>黄玉宏　　二○○九年一月二日</p><p><br/></p>
页: [1]
查看完整版本: 图层的线型定义