版主您好,有什么办法可以给多线加线宽的???
单线可以有命令加宽,这个我也需要 可以用"pedit"命令. 多线直接选取就可以改线宽属性! 我有一个小程序可以的,可怎么给你啊?! 用这个程序,可以多选!Sub jcx()
Dim a
On Error Resume Next
Dim i As Integer
Dim allobj As AcadEntity'声明对象
Dim spnt As Variant '声明直线的开始点坐标
Dim epnt As Variant '声明直线的结束点坐标
Dim plineobj As AcadLWPolyline '声明细多段线
Dim ver(0 To 3) As Double '声明细多段线坐标点数组
For i = 0 To ThisDrawing.SelectionSets.Count - 1
ThisDrawing.SelectionSets.Item(i).Clear
ThisDrawing.SelectionSets.Item(i).Delete
Next
Dim sset As AcadSelectionSet
Set sset = ThisDrawing.SelectionSets.Add("lineset")
sset.SelectOnScreen
If sset.Count = 0 Then Exit Sub
Dim w As String
w = ThisDrawing.Utility.GetString(1, vbCrLf & "请输入宽度:")
For Each allobj In sset '遍历空间的每一个对象
If allobj.ObjectName <> "AcDbLine" Then '若为多段线
allobj.ConstantWidth = w
End If
If allobj.ObjectName = "AcDbLine" Then '若为直线
spnt = allobj.StartPoint '将直线的开始点坐标赋值到spnt
epnt = allobj.EndPoint ''将直线的结束点坐标赋值到epnt
'将坐标写入数组
ver(0) = spnt(0): ver(1) = spnt(1)
ver(2) = epnt(0): ver(3) = epnt(1)
'生成多段线
Set plineobj = ThisDrawing.ModelSpace.AddLightWeightPolyline(ver)
'线宽为2
plineobj.ConstantWidth = w
allobj.Delete
End If
'删除直线
Next '循环至下一对象
Exit Sub
End Sub zyqhp78发表于2003-11-1 10:01:00static/image/common/back.gif版主您好,有什么办法可以给多线加线宽的???
你用的是哪个版本?
R14在打印时可以分颜色设置
R2000以上可以先设置线宽, 用LWDISPLAY命令显示,在打印时设置打印线宽
页:
[1]