让四边形的每条边偏移不一样的值

charlesli8

不管多少明经币  不是钱数的问题  是行不行的问题。  想的话谁都会想。我写了3页的代码  发现还是有很多问题。

zzyong00

charlesli8 发表于 2015-2-7 12:36
不管多少明经币  不是钱数的问题  是行不行的问题。  想的话谁都会想。我写了3页的代码  发现还是有很多问题 ...

随你的意思吧！

主要模块：
偏移四边形.zip(等待你的20个币),
主要调用sub：OffsetQuadrangle (针对凸四边形)
调用代码：

1. Private Sub Command1_Click()
   
2.     Dim objSset As AcadSelectionSet
   
3.     Dim objDoc As AcadDocument
   
4.     Set objDoc = ThisDrawing()
   
5.     AppActivate objCad.Caption
   
6.     SelectLots "MEA~PL~TMP~123", "lwpolyline"
   
7.     Set objSset = objDoc.SelectionSets("MEA~PL~TMP~123")
   
8.     If objSset.Count = 0 Then Exit Sub
   
9.     Dim i As Long, objRetPl As AcadLWPolyline, offDist(3) As Double
   
10.     offDist(0) = 5
    
11.     offDist(1) = 10
    
12.     offDist(2) = 15
    
13.     offDist(3) = 20
    
14. '    offDist(0) = -5   '向内侧偏移
    
15. '    offDist(1) = -10
    
16. '    offDist(2) = -15
    
17. '    offDist(3) = -20
    
18. '
    
19.     For i = 0 To objSset.Count - 1
    
20.         OffsetQuadrangle objSset.Item(i), offDist, objRetPl
    
21.     Next i
    
22. End Sub
    

Private Sub Command1_Click()<br />     Dim objSset As AcadSelectionSet<br />     Dim objDoc As AcadDocument<br />     Set objDoc = ThisDrawing()<br />     AppActivate objCad.Caption<br />     SelectLots "MEA~PL~TMP~123", "lwpolyline"<br />     Set objSset = objDoc.SelectionSets("MEA~PL~TMP~123")<br />     If objSset.Count = 0 Then Exit Sub<br />     Dim i As Long, objRetPl As AcadLWPolyline, offDist(3) As Double<br />     offDist(0) = 5<br />     offDist(1) = 10<br />     offDist(2) = 15<br />     offDist(3) = 20<br /> '    offDist(0) = -5   '向内侧偏移<br /> '    offDist(1) = -10<br /> '    offDist(2) = -15<br /> '    offDist(3) = -20<br /> '<br />     For i = 0 To objSset.Count - 1<br />         OffsetQuadrangle objSset.Item(i), offDist, objRetPl<br />     Next i<br /> End Sub<br />

没有的函数、方法，还请参见我的哪个帖子：http://bbs.mjtd.com/thread-111783-1-1.html