a280881620 发表于 2013-6-16 21:40:49

vba怎么实现修改指定图层的线宽和文字高度


我想用vba遍历我的当前文件的所有层，然后对指定的层进行线宽和文字高度的设置怎么实现，我的代码如下，但无法达到功能，求高手指点。
Sub zongtu()
On Error Resume Next
Dim I As Integer
Dim msg As String
msg = ""
Dim a As Double
a = ThisDrawing.Layers.Count - 1
For I = 0 To a
If ThisDrawing.Layers.Item(I).Name = "DLSS" Then
msg = ThisDrawing.Layers.Item(I).Name
ThisDrawing.Layers(I).Lineweight = 0

Next
'遍历图层，对dlss层的线宽设置为0，文字高度设置为1.25
End Sub


yshf 发表于 2013-6-17 19:06:39

本帖最后由 yshf 于 2013-6-17 22:01 编辑

试试这个Sub zongtu()
    On Error Resume Next
   
    Dim LayObj As AcadLayer
    For Each LayObj In ThisDrawing.Layers
      If LayObj.Name = "DLSS" Then
         LayObj.Lineweight = 0
      End If
    Next
   
    Dim Ssd As AcadSelectionSet
    Dim FType(0 To 4) As Integer
    Dim FData(0 To 4) As Variant
    Dim TeObj As Object
   
    FType(0) = -4
    FType(1) = 0
    FType(2) = 0
    FType(3) = -4
    FType(4) = 8
   
    FData(0) = "<or"
    FData(1) = "text"
    FData(2) = "mtext"
    FData(3) = "or>"
    FData(4) = "DLSS"
   
    ThisDrawing.SelectionSets("Ssd").Delete
   
    '创建选择集(选择图层为DLSS,图元实体为文字的选择集)
    Set Ssd = ThisDrawing.SelectionSets.Add("Ssd")
    Ssd.Select acSelectionSetAll, , , FType, FData
    For Each TeObj In Ssd
      TeObj.Height = 1.25
    Next
   
End Sub

yshf 发表于 2013-6-17 21:51:48

相应的lisp(defun c:cc()
    (setq tcm"DLSS"
          Tcobj(vlax-ename->vla-object (tblobjname "layer" tcm))
    )
   
    (vlax-put Tcobj "Lineweight" 0)
    (if (setq Ssd (ssget "x" (list '(0 . "*text") (cons 8 tcm))))
      (progn
            (setq n (sslength Ssd) i 0)
          (repeat n
                (setq dxf (entget (ssname Ssd i))
                      dxf (subst (cons 40 1.25) (assoc 40 dxf) dxf)
                      i   (1+ i)
                )
                (entmod dxf)
          )
        )
    )
    (princ)
)

a280881620 发表于 2013-6-21 22:01:26

yshf 发表于 2013-6-17 21:51 static/image/common/back.gif
相应的lisp

谢谢，认真学习了

俺就一粗人 发表于 2014-3-7 12:04:10

这个对于学lisp的人来说很有用啊

树櫴希德 发表于 2014-3-7 21:23:39

楼主大公无私

a280881620 发表于 2014-4-8 13:15:33

yshf 发表于 2013-6-17 21:51 static/image/common/back.gif
相应的lisp

谢谢，你这个不错

a280881620 发表于 2014-4-8 13:17:49

yshf 发表于 2013-6-17 21:51 static/image/common/back.gif
相应的lisp

你那里有关于lisp编程的书推荐没啊，我只会vba，想学lisp

yshf 发表于 2014-4-8 20:19:43

1、《Auto LISP & DCL基础篇》 吴永进林美樱编著
2、《Visual LISP程序设计——技巧与范例》 陈伯雄 冯伟编著

a280881620 发表于 2014-4-9 12:13:24

yshf 发表于 2013-6-17 19:06 static/image/common/back.gif
试试这个

追问一下，你这个vba改线宽的，我想改dlss层的多段线的全局宽度为0怎么弄
页: [1] 2
查看完整版本: vba怎么实现修改指定图层的线宽和文字高度