社区 › VB › 求助

yingxunxue 发表于 2004-6-19 20:33:00

求助

怎样把一个整个图层中的图形MIRROR或MOVE
怎么把图形中倒数第N个图形MIRROR 或MOVE

雪山飞狐_lzh 发表于 2004-6-19 20:42:00

Signature
object.Move Point1, Point2
Object
,
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
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 .

yingxunxue 发表于 2004-6-19 20:56:00

这个我在帮助里看到过
我现在要做的是把倒数第32到最后一个图形,整体移动
或者说把一个图层中的所有图形

雪山飞狐_lzh 发表于 2004-6-19 21:01:00

用For循环做呀
或SendCommand
参见

yingxunxue 发表于 2004-6-19 21:32:00

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 & "请输入操作名:")
               ThisDrawing.SendCommand "." & pControl & vbCr & "p" & vbCr & vbCr
       End If如果我不需要在CAD中选择等操作,直接在代码中实现.可以吗?

雪山飞狐_lzh 发表于 2004-6-19 22:19:00

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

yingxunxue 发表于 2004-6-20 08:19:00

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

雪山飞狐_lzh 发表于 2004-6-20 10:10:00

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 发表于 2004-6-20 10:12:00

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 发表于 2004-6-20 10:17:00

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

查看完整版本: 求助