如何修改选择集中对象的属性

291118 发表于 2005-9-6 16:04:00

我想先将选择集中的对象复制　然后再将其图案名改成别的图案，怎么也试验不成功请高手指点！　谢谢
Dim acadDoc As AcadDocument
 Private Sub Command1_Click()
On Error Resume Next Set acadApp = GetObject(, "AutoCAD.Application") If Err Then Err.Clear Set acadApp = CreateObject("AutoCAD.Application") If Err Then End End If acadApp.Visible = True Set acadDoc = acadApp.ActiveDocument Dim ssetObj As AcadSelectionSet
  K = -1  For i = 0 To acadDoc.SelectionSets.Count - 1  If acadDoc.SelectionSets.Item(i).Name = "SSET" Then acadDoc.SelectionSets.Item(i).Delete   Next i   Set ssetObj = acadDoc.SelectionSets.Add("SSET")
  Dim corner1(0 To 2) As Double   Dim corner2(0 To 2) As Double     corner1(0) = 0: corner1(1) = 0: corner1(2) = 0     corner2(0) = 200: corner2(1) = 200: corner2(2) = 0
    Dim gpCode(0) As Integer     Dim dataValue(0) As Variant     gpCode(0) = 0     dataValue(0) = "HATCH"    ' gpCode(1) = 2    ' dataValue(1) = "SOLID"
    Dim groupCode As Variant, dataCode As Variant     groupCode = gpCode     dataCode = dataValue     ssetObj.Select acSelectionSetAll, , , groupCode, dataCode   For i = 0 To ssetObj.Count - 1    ssetObj.Item(i).Move corner1, corner2   Next i
End Sub

雪山飞狐_lzh 发表于 2005-9-6 20:03:00

复制用Copy函数

291118 发表于 2005-9-7 08:20:00

经过研究能考贝了，只能改变颜色，但不能修改图案名　代码如下
Dim acadApp As AcadApplication Dim acadDoc As AcadDocument
 Private Sub Command1_Click()
On Error Resume Next Set acadApp = GetObject(, "AutoCAD.Application") If Err Then Err.Clear Set acadApp = CreateObject("AutoCAD.Application") If Err Then End End If acadApp.Visible = True Set acadDoc = acadApp.ActiveDocument Dim ssetObj As AcadSelectionSet Dim COPYObj As AcadEntity Dim ss As Object Dim s1, s2 As AcadHatch Dim acad_obj As AcadObject
 K = -1  For i = 0 To acadDoc.SelectionSets.Count - 1  If acadDoc.SelectionSets.Item(i).Name = "SSET" Then acadDoc.SelectionSets.Item(i).Delete   Next i  Set ssetObj = acadDoc.SelectionSets.Add("SSET")
Dim corner1(0 To 2) As Double   Dim corner2(0 To 2) As Double     corner1(0) = 0: corner1(1) = 0: corner1(2) = 0     corner2(0) = 200: corner2(1) = 200: corner2(2) = 0     Dim gpCode(0) As Integer     Dim dataValue(0) As Variant     gpCode(0) = 0     dataValue(0) = "HATCH"    ' gpCode(1) = 2    ' dataValue(1) = "SOLID"
    Dim groupCode As Variant, dataCode As Variant     groupCode = gpCode     dataCode = dataValue      ssetObj.Clear     ssetObj.Select acSelectionSetAll, , , groupCode, dataCode  Set s1 = ssetObj.Item(0)  Set s2 = s1.Copy  ssetObj.Item(0).Move corner1, corner2  s1.Color = 2  s2.Color = 1  MsgBox s2.PatternName  s2.PatternName = "asni32" '这儿就出错了　说是只读  ssetObj.Clear     
End Sub

wenwengg 发表于 2008-2-1 14:46:00

'图案名改成别的图案hatchObj.SetPattern acHatchPatternTypePreDefined, "BRICK"

页: [1]

明经CAD社区's Archiver

如何修改选择集中对象的属性