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

求助

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


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

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

<P class=Heading-2>Signature
<P class=syntax>object.Move Point1, Point2
<P class=element>Object


<P class=element-desc><A href="mk:@MSITStore:D:\Program%20Files\AutoCAD%202005\help\acadauto.chm::/all_drawing_objects.htm" target="_blank" >All Drawing Objects</A>, <A href="mk:@MSITStore:D:\Program%20Files\AutoCAD%202005\help\acadauto.chm::/idh_attributeref_object.htm" target="_blank" >AttributeReference</A><BR>The object or objects this method applies to.
<P class=element>Point1


<P class=element-desc>Variant (three-element array of doubles); input-only<BR>The 3D WCS coordinates specifying the first point of the move vector.
<P class=element>Point2


<P class=element-desc>Variant (three-element array of doubles); input-only<BR>The 3D WCS coordinates specifying the second point of the move vector.


<P class=element-desc>       


<P class=Heading-2>Signature
<P class=syntax>RetVal = object.Mirror(Point1, Point2)
<P class=element>Object


<P class=element-desc><A href="mk:@MSITStore:D:\Program%20Files\AutoCAD%202005\help\acadauto.chm::/all_drawing_objects.htm" target="_blank" >All Drawing Objects</A><BR>The object or objects this method applies to.
<P class=element>Point1


<P class=element-desc>Variant (three-element array of doubles); input-only<BR>The 3D WCS coordinates specifying the first point of the mirror axis.
<P class=element>Point2


<P class=element-desc>Variant (three-element array of doubles); input-only<BR>The 3D WCS coordinates specifying the second point of the mirror axis.
<P class=element>RetVal


<P class=element-desc>Mirrored object<BR>This object can be one of any <A href="mk:@MSITStore:D:\Program%20Files\AutoCAD%202005\help\acadauto.chm::/all_drawing_objects.htm" target="_blank" >Drawing Objects</A>.

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

这个我在帮助里看到过


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


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

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

用For循环做呀


或SendCommand


参见<A href="http://bbs.mjtd.com/forum.php?mod=viewthread&tid=20705" target="_blank" >http://bbs.mjtd.com/forum.php?mod=viewthread&tid=20705</A>

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是你程序中获得的实体数组或集合或选择集For Each i In pObjs
         i.Move Point1, Point2
Next i

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

lzh741206发表于2004-6-19 22:19:00static/image/common/back.gif假设pObjs是你程序中获得的实体数组或集合或选择集



For Each i In pObjs                                       i.Move Point1, Point2 Next i


大哥:帮我写完整一点好吗?


先MIRROR后MOVE(层中的所有图形)


急用<BR>

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

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

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


出现错误<BR>
页: [1] 2
查看完整版本: 求助