[求助]：诸们大侠，有没有在AUTOCAD中直线加粗的程序

cqcao

如题

playboy

直接用pedit不就可以了吗

jxsqq

用pedit命令，然后选择参数J，在选择参数W，给个宽度就可以了

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

epnt = allobj.EndPoint

ver(0) = spnt(0): ver(1) = spnt(1)
ver(2) = epnt(0): ver(3) = epnt(1)



Set plineobj = ThisDrawing.ModelSpace.AddLightWeightPolyline(ver)



plineobj.ConstantWidth = w
allobj.Delete
End If




Next
Exit Sub

playboy

myfreemind 大虾不是明经的斑竹吗，你真是太伟大了。简直就是救苦救难的观世音呢

chlian

或者用一些建筑软件的功能

小狼

(defun c:lw (/ width1 xx n)
  (setvar "cmdecho" 0)
  (setq width1 (getreal "\n请输入线宽:"))
  (princ "\n请选择线段(可选多段):")
  (setq        xx (ssget (list        (CONS 0 "*POLYLINE")
                  )
           )
        n  (1- (sslength xx))
  )
  (repeat (sslength xx)
    (setq name (ssname xx n))
    (command "pedit" name "w" width1 "x")
    (setq n (1+ n))
  )
  (setvar "cmdecho" 1)
  (princ)
)

zwindcn

有没有，Line直接加粗的。

myfreemind

最初由 zwindcn 发布
[B]有没有，Line直接加粗的。 [/B]

什么意思？

rakey_914

可以用天正，或者用理正建筑直接加粗原理和AUTOCAD的PEDIT一样

四圈儿

谢谢jxsqq，以前一直不知道有这个命令，它对我的工作太有帮助了，非常感谢  
*-*1

dengfei2000

H

j_123a

用打印样式控制线宽就可以了，没必要这么麻烦