求助

yingxunxue

怎样把一个整个图层中的图形MIRROR或MOVE


怎么把图形中倒数第N个图形MIRROR 或MOVE

雪山飞狐_lzh

Signature

object.Move Point1, Point2

Object

MSITStore:D:\Program%20Files\AutoCAD%202005\help\acadauto.chm::/all_drawing_objects.htm" target="_blank" >All Drawing Objects, MSITStore:D:\Program%20Files\AutoCAD%202005\help\acadauto.chm::/idh_attributeref_object.htm" target="_blank" >AttributeReference
The object or objects this method applies to.

Point1

Variant (three-element array of doubles); input-only
The 3D WCS coordinates specifying the first point of the move vector.

Point2

Variant (three-element array of doubles); input-only
The 3D WCS coordinates specifying the second point of the move vector.

Signature

RetVal = object.Mirror(Point1, Point2)

Object

MSITStore:D:\Program%20Files\AutoCAD%202005\help\acadauto.chm::/all_drawing_objects.htm" target="_blank" >All Drawing Objects
The object or objects this method applies to.

Point1

Variant (three-element array of doubles); input-only
The 3D WCS coordinates specifying the first point of the mirror axis.

Point2

Variant (three-element array of doubles); input-only
The 3D WCS coordinates specifying the second point of the mirror axis.

RetVal

Mirrored object
This object can be one of any MSITStore:D:\Program%20Files\AutoCAD%202005\help\acadauto.chm::/all_drawing_objects.htm" target="_blank" >Drawing Objects.

yingxunxue

这个我在帮助里看到过


我现在要做的是把倒数第32到最后一个图形,整体移动


或者说把一个图层中的所有图形

雪山飞狐_lzh

用For循环做呀 或SendCommand 参见http://bbs.mjtd.com/forum.php?mod=viewthread&tid=20705

yingxunxue

2. Sub QSelLayerControl()
3. '程序功能:快速选取一层的所有对象,进行相应的操作
4.        Dim i   As AcadEntity
5.        Dim ss As AcadSelectionSet
6.        Dim ft(0) As Integer, fd(0)
7.        Dim pLayer As String
8.        Dim pControl As String
9.        pLayer = ThisDrawing.Utility.GetString(0, vbCrlLf & "请输入层名:")
10.        ft(0) = 8: fd(0) = pLayer
11.        Set ss = ThisDrawing.ActiveSelectionSet
12.        ss.Clear
13.        ss.Select acSelectionSetAll, , , ft, fd
14.        If ss.Count = 0 Then
15.                ss.Delete
16.                ThisDrawing.Utility.Prompt "层内没有对象或层不存在!"
17.        Else
18.                ThisDrawing.Utility.InitializeUserInput 1, "Move Copy Erase"
19.                pControl = ThisDrawing.Utility.GetKeyword(vbCr & "请输入操作名[Move(移动)/Copy(复制)/Erase(删除)]:")
20.                ThisDrawing.SendCommand "." & pControl & vbCr & "p" & vbCr & vbCr
21.        End If

Sub QSelLayerControl() '程序功能:快速选取一层的所有对象,进行相应的操作        Dim i   As AcadEntity        Dim ss As AcadSelectionSet        Dim ft(0) As Integer, fd(0)        Dim pLayer As String        Dim pControl As String        pLayer = ThisDrawing.Utility.GetString(0, vbCrlLf & "请输入层名:")        ft(0) = 8: fd(0) = pLayer        Set ss = ThisDrawing.ActiveSelectionSet        ss.Clear        ss.Select acSelectionSetAll, , , ft, fd        If ss.Count = 0 Then                ss.Delete                ThisDrawing.Utility.Prompt "层内没有对象或层不存在!"        Else                ThisDrawing.Utility.InitializeUserInput 1, "Move Copy Erase"                pControl = ThisDrawing.Utility.GetKeyword(vbCr & "请输入操作名[Move(移动)/Copy(复制)/Erase(删除)]:")                ThisDrawing.SendCommand "." & pControl & vbCr & "p" & vbCr & vbCr        End If

如果我不需要在CAD中选择等操作,直接在代码中实现.可以吗?

雪山飞狐_lzh

假设pObjs是你程序中获得的实体数组或集合或选择集

1. For Each i In pObjs
2.            i.Move Point1, Point2
3. Next i

复制代码

yingxunxue

lzh741206发表于2004-6-19 22:19:00假设pObjs是你程序中获得的实体数组或集合或选择集 For Each i In pObjs i.Move Point1, Point2 Next i

大哥:帮我写完整一点好吗? 先MIRROR后MOVE(层中的所有图形) 急用

雪山飞狐_lzh

Sub MMLayer(ByVal LayerName As String, ByVal p1, ByVal p2, ByVal p3, ByVal p4)
Dim i As AcadEntity
Dim ft(0) As Integer, fd(0)
Dim ss As AcadSelectionSet
Set ss = ThisDrawing.SelectionSets.Add("*TlsTest*")
ft(0) = 8: fd(0) = LayerName
ss.Select acSelectionSetAll, , , ft, fd
For Each i In ss
i.Mirror(p1, p2).Move p3, p4
i.Delete
Next i
ErrHandle:
ss.Delete
End Sub

yingxunxue

2. Sub zhouhui1()
3. Dim layerObj As AcadLayerSet layerObj = ThisDrawing.Layers.Add("ABC")  Dim x As AcadObject
4. 'x.Color = acByLayer
5. For Each x In ThisDrawing.ModelSpace
6.      x.Layer = "ABC"
7.      
8. ' 指定“ABC”图层的颜色为红色     ' x.Color = acRed
9.        x.Update
10. Next xDim point1(0 To 2) As Double
11.        Dim point2(0 To 2) As Double
12.        point1(0) = 0: point1(1) = 0: point1(2) = 0
13.        point2(0) = 2: point2(1) = 0: point2(2) = 0
14. Dim i As AcadObject
15. For Each i In layerObj
16.            i.Move point1, point2
17. Next iEnd Sub

Sub zhouhui1() Dim layerObj As AcadLayerSet layerObj = ThisDrawing.Layers.Add("ABC")  Dim x As AcadObject 'x.Color = acByLayer For Each x In ThisDrawing.ModelSpace      x.Layer = "ABC"       ' 指定“ABC”图层的颜色为红色     ' x.Color = acRed        x.Update Next xDim point1(0 To 2) As Double        Dim point2(0 To 2) As Double        point1(0) = 0: point1(1) = 0: point1(2) = 0        point2(0) = 2: point2(1) = 0: point2(2) = 0 Dim i As AcadObject For Each i In layerObj            i.Move point1, point2 Next iEnd Sub

帮我看看最后几行吧,有问题呀

yingxunxue

大哥帮忙呀. 我已经写了上面的程序了,可是运行到For Each i In layerObj 出现错误