版主您好,有什么办法可以给多线加线宽的???

zyqhp78

boomxp

单线可以有命令加宽，这个我也需要

wanggy169

可以用"pedit"命令.

myfreemind

多线直接选取就可以改线宽属性!

psd

我有一个小程序可以的，可怎么给你啊？！

myfreemind

用这个程序，可以多选！


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

typ

zyqhp78发表于2003-11-1 10:01:00版主您好,有什么办法可以给多线加线宽的???

你用的是哪个版本？
R14在打印时可以分颜色设置
R2000以上可以先设置线宽， 用LWDISPLAY命令显示，在打印时设置打印线宽