chtd
发表于 2007-12-10 21:42:00
作了几个程序
<p>Sub sdxc() '-------------------------删线上点(一定距离范围内)<br/>Call pdxu<br/>Dim gpCode(0) As Integer<br/>Dim dataValue(0) As Variant<br/>Dim gpcode1(0) As Integer<br/>Dim datavalue1(0) As Variant<br/>Dim groupCode As Variant, dataCode As Variant<br/>Dim groupCode1 As Variant, dataCode1 As Variant<br/>Dim mysel2 As AcadSelectionSet<br/>Dim mysel As AcadSelectionSet<br/>Dim mysel1 As AcadSelectionSet<br/>Dim lyr As AcadLayer<br/>Dim ersa As Boolean<br/>ersa = False<br/>gpCode(0) = 8<br/>dataValue(0) = "xzb"<br/>groupCode = gpCode<br/>dataCode = dataValue</p><p>gpcode1(0) = 8<br/>datavalue1(0) = "szh"<br/>groupCode1 = gpcode1<br/>dataCode1 = datavalue1<br/>If ThisDrawing.SelectionSets.count = 0 Then<br/>Set mysel = ThisDrawing.SelectionSets.Add("mysel")<br/>AppActivate ThisDrawing.Application.Caption<br/>mysel.Select acSelectionSetAll, , , groupCode, dataCode<br/>Set mysel1 = ThisDrawing.SelectionSets.Add("mysel1")<br/>mysel1.Select acSelectionSetAll, , , groupCode1, dataCode1<br/>Else<br/>For Each xusel In ThisDrawing.SelectionSets<br/>xusel.Delete<br/>Next<br/>Set mysel = ThisDrawing.SelectionSets.Add("mysel")<br/>AppActivate ThisDrawing.Application.Caption<br/>mysel.Select acSelectionSetAll, , , groupCode, dataCode<br/>Set mysel1 = ThisDrawing.SelectionSets.Add("mysel1")<br/>mysel1.Select acSelectionSetAll, , , groupCode1, dataCode1<br/>End If</p><p>On Error GoTo re<br/>cx = ThisDrawing.Utility.GetString(0, "请输入限差:")</p><p>Dim zuob(0 To 35) As Double</p><p>Dim z1 As Variant</p><p>Set lyr = ThisDrawing.Layers.Add("查线上点")<br/>ThisDrawing.ActiveLayer = lyr</p><p>If cx <> "" Then</p><p>For Each selentity In mysel<br/> If selentity.EntityType = acPoint Then<br/> z1 = selentity.Coordinates<br/> z1(0) = z1(0): z1(1) = z1(1): z1(2) = 0<br/> R = Val(cx)<br/> z1(0) = z1(0): z1(1) = z1(1): z1(2) = 0<br/> zuob(0) = z1(0) - R / 6 * 6: zuob(1) = z1(1): zuob(2) = 0<br/> zuob(3) = z1(0) - R / 6 * 5.196: zuob(4) = z1(1) + R / 6 * 3: zuob(5) = 0<br/> zuob(6) = z1(0) - R / 6 * 3: zuob(7) = z1(1) + R / 6 * 5.196: zuob(8) = 0<br/> zuob(9) = z1(0): zuob(10) = z1(1) + R / 6 * 6: zuob(11) = 0<br/> zuob(12) = z1(0) + R / 6 * 3: zuob(13) = z1(1) + R / 6 * 5.196: zuob(14) = 0<br/> zuob(15) = z1(0) + R / 6 * 5.196: zuob(16) = z1(1) + R / 6 * 3: zuob(17) = 0<br/> zuob(18) = z1(0) + R / 6 * 6: zuob(19) = z1(1): zuob(20) = 0<br/> zuob(21) = z1(0) + R / 6 * 5.196: zuob(22) = z1(1) - R / 6 * 3: zuob(23) = 0<br/> zuob(24) = z1(0) + R / 6 * 3: zuob(25) = z1(1) - R / 6 * 5.196: zuob(26) = 0<br/> zuob(27) = z1(0): zuob(28) = z1(1) - R / 6 * 6: zuob(29) = 0<br/> zuob(30) = z1(0) - R / 6 * 3: zuob(31) = z1(1) - R / 6 * 5.196: zuob(32) = 0<br/> zuob(33) = z1(0) - R / 6 * 5.196: zuob(34) = z1(1) - R / 6 * 3: zuob(35) = 0<br/> Set mysel2 = ThisDrawing.SelectionSets.Add("mysel2")</p><p> mysel2.SelectByPolygon acSelectionSetCrossingPolygon, zuob<br/> <br/> If mysel2.count > 0 Then<br/> For Each ss In mysel2<br/> If ss.EntityType = 2 Or ss.EntityType = 24 Then<br/> ersa = True<br/> Exit For<br/> End If<br/> Next<br/> End If<br/> <br/> If ersa = True Then<br/> selentity.Delete<br/> End If<br/> ersa = False<br/> mysel2.Delete<br/> End If<br/> <br/>Next<br/>End If<br/>MsgBox "ok"<br/>re:<br/> mysel.Delete<br/> mysel1.Delete<br/>End Sub</p><p> </p><p></p><p></p>
上善若水！@#
发表于 2017-12-8 16:34:17
你好，那个加载了lsp后提示no function definition: CENTSEL是怎么回事，有解决方法不
chtd
发表于 2007-12-10 21:45:00
<p>Sub dxlj()‘-------------------------------多线连接<br/>Dim zuobiao As Variant<br/>Dim zuobiao1 As Variant<br/>Dim xuln As AcadLWPolyline<br/>On Error GoTo we</p><p>Dim mysel As AcadSelectionSet<br/>If ThisDrawing.SelectionSets.count = 0 Then<br/>Set mysel = ThisDrawing.SelectionSets.Add("mysel")<br/>AppActivate ThisDrawing.Application.Caption<br/>mysel.SelectOnScreen<br/>Else<br/>ThisDrawing.SelectionSets.Item(0).Delete<br/>Set mysel = ThisDrawing.SelectionSets.Add("mysel")<br/>AppActivate ThisDrawing.Application.Caption<br/>mysel.SelectOnScreen<br/>End If</p><p>If mysel.count = 2 Then<br/>Dim minn As Integer<br/>Dim minn1 As Integer<br/>If mysel(0).EntityType = 24 And mysel(1).EntityType = 24 Then<br/>zuobiao = mysel(0).Coordinates<br/>zuobiao1 = mysel(1).Coordinates<br/>minn = UBound(zuobiao)<br/>minn1 = UBound(zuobiao1)</p><p>ReDim zuobb(0 To minn + minn1 + 1) As Double</p><p>If Sqr((zuobiao(UBound(zuobiao) - 1) - zuobiao1(0)) ^ 2 + (zuobiao(UBound(zuobiao)) - zuobiao1(1)) ^ 2) _<br/>< Sqr((zuobiao(UBound(zuobiao) - 1) - zuobiao1(UBound(zuobiao1) - 1)) ^ 2 + (zuobiao(UBound(zuobiao)) - zuobiao1(UBound(zuobiao1))) ^ 2) And Sqr((zuobiao(UBound(zuobiao) - 1) - zuobiao1(0)) ^ 2 + (zuobiao(UBound(zuobiao)) - zuobiao1(1)) ^ 2) _<br/>< Sqr((zuobiao(0) - zuobiao1(0)) ^ 2 + (zuobiao(1) - zuobiao1(1)) ^ 2) Then<br/>For i = 0 To minn<br/> zuobb(i) = zuobiao(i)<br/>Next</p><p>For i = 0 To minn1<br/> zuobb(i + minn + 1) = zuobiao1(i)<br/>Next</p><p>ElseIf Sqr((zuobiao(UBound(zuobiao) - 1) - zuobiao1(UBound(zuobiao1) - 1)) ^ 2 + (zuobiao(UBound(zuobiao)) - zuobiao1(UBound(zuobiao1))) ^ 2) _<br/>< Sqr((zuobiao(UBound(zuobiao) - 1) - zuobiao1(0)) ^ 2 + (zuobiao(UBound(zuobiao)) - zuobiao1(1)) ^ 2) And Sqr((zuobiao(UBound(zuobiao) - 1) - zuobiao1(UBound(zuobiao1) - 1)) ^ 2 + (zuobiao(UBound(zuobiao)) - zuobiao1(UBound(zuobiao1))) ^ 2) _<br/>< Sqr((zuobiao(0) - zuobiao1(UBound(zuobiao1) - 1)) ^ 2 + (zuobiao(1) - zuobiao1(UBound(zuobiao1))) ^ 2) Then<br/>For i = 0 To minn<br/> zuobb(i) = zuobiao(i)<br/>Next</p><p>For i = 0 To minn1 Step 2<br/> zuobb(i + minn + 1) = zuobiao1(minn1 - i - 1)<br/> zuobb(i + minn + 2) = zuobiao1(minn1 - i)<br/>Next</p><p>ElseIf Sqr((zuobiao(0) - zuobiao1(0)) ^ 2 + (zuobiao(1) - zuobiao1(1)) ^ 2) _<br/>< Sqr((zuobiao(0) - zuobiao1(UBound(zuobiao1) - 1)) ^ 2 + (zuobiao(1) - zuobiao1(UBound(zuobiao1))) ^ 2) And Sqr((zuobiao(0) - zuobiao1(0)) ^ 2 + (zuobiao(1) - zuobiao1(1)) ^ 2) _<br/>< Sqr((zuobiao(UBound(zuobiao) - 1) - zuobiao1(0)) ^ 2 + (zuobiao(UBound(zuobiao)) - zuobiao1(1)) ^ 2) Then<br/>For i = 0 To minn Step 2<br/> zuobb(i) = zuobiao(minn - i - 1)<br/> zuobb(i + 1) = zuobiao(minn - i)<br/>Next</p><p>For i = 0 To minn1<br/> zuobb(i + minn + 1) = zuobiao1(i)<br/>Next</p><p>ElseIf Sqr((zuobiao(0) - zuobiao1(UBound(zuobiao1) - 1)) ^ 2 + (zuobiao(1) - zuobiao1(UBound(zuobiao1))) ^ 2) _<br/>< Sqr((zuobiao(0) - zuobiao1(0)) ^ 2 + (zuobiao(1) - zuobiao1(1)) ^ 2) And Sqr((zuobiao(0) - zuobiao1(UBound(zuobiao1) - 1)) ^ 2 + (zuobiao(1) - zuobiao1(UBound(zuobiao1))) ^ 2) _<br/>< Sqr((zuobiao(UBound(zuobiao) - 1) - zuobiao1(UBound(zuobiao1) - 1)) ^ 2 + (zuobiao(UBound(zuobiao)) - zuobiao1(UBound(zuobiao1))) ^ 2) Then</p><p>For i = 0 To minn Step 2<br/> zuobb(i) = zuobiao(minn - i - 1)<br/> zuobb(i + 1) = zuobiao(minn - i)<br/>Next</p><p>For i = 0 To minn1 Step 2<br/> zuobb(i + minn + 1) = zuobiao1(minn1 - i - 1)<br/> zuobb(i + minn + 2) = zuobiao1(minn1 - i)<br/>Next</p><p>End If<br/>ThisDrawing.ActiveLayer = ThisDrawing.Layers(mysel(0).Layer)</p><p>Set xuln = ThisDrawing.ModelSpace.AddLightWeightPolyline(zuobb)<br/>xuln.Elevation = mysel(0).Elevation<br/>xuln.Thickness = mysel(0).Thickness<br/>xuln.ConstantWidth = mysel(0).ConstantWidth<br/>xuln.Linetype = mysel(0).Linetype<br/>xuln.color = mysel(0).color<br/>xuln.Lineweight = mysel(0).Lineweight<br/>mysel(0).Delete<br/>mysel(1).Delete<br/>ElseIf mysel(0).EntityType = 2 And mysel(1).EntityType = 2 Then<br/>zuobiao = mysel(0).Coordinates<br/>zuobiao1 = mysel(1).Coordinates<br/>minn = UBound(zuobiao)<br/>minn1 = UBound(zuobiao1)</p><p>ReDim zuobb(0 To minn + minn1 + 1) As Double<br/>If Sqr((zuobiao(UBound(zuobiao) - 2) - zuobiao1(0)) ^ 2 + (zuobiao(UBound(zuobiao) - 1) - zuobiao1(1)) ^ 2) _<br/>< Sqr((zuobiao(UBound(zuobiao) - 2) - zuobiao1(UBound(zuobiao1) - 2)) ^ 2 + (zuobiao(UBound(zuobiao) - 1) - zuobiao1(UBound(zuobiao1) - 1)) ^ 2) And Sqr((zuobiao(UBound(zuobiao) - 2) - zuobiao1(0)) ^ 2 + (zuobiao(UBound(zuobiao) - 1) - zuobiao1(1)) ^ 2) _<br/>< Sqr((zuobiao(0) - zuobiao1(0)) ^ 2 + (zuobiao(1) - zuobiao1(1)) ^ 2) Then<br/>For i = 0 To minn<br/> zuobb(i) = zuobiao(i)<br/>Next</p><p>For i = 0 To minn1<br/> zuobb(i + minn + 1) = zuobiao1(i)<br/>Next<br/>ElseIf Sqr((zuobiao(UBound(zuobiao) - 2) - zuobiao1(UBound(zuobiao1) - 2)) ^ 2 + (zuobiao(UBound(zuobiao) - 1) - zuobiao1(UBound(zuobiao1) - 1)) ^ 2) _<br/>< Sqr((zuobiao(UBound(zuobiao) - 2) - zuobiao1(0)) ^ 2 + (zuobiao(UBound(zuobiao) - 1) - zuobiao1(1)) ^ 2) And Sqr((zuobiao(UBound(zuobiao) - 2) - zuobiao1(UBound(zuobiao1) - 2)) ^ 2 + (zuobiao(UBound(zuobiao) - 1) - zuobiao1(UBound(zuobiao1) - 1)) ^ 2) _<br/>< Sqr((zuobiao(0) - zuobiao1(UBound(zuobiao1) - 2)) ^ 2 + (zuobiao(1) - zuobiao1(UBound(zuobiao1) - 1)) ^ 2) Then<br/>For i = 0 To minn<br/> zuobb(i) = zuobiao(i)<br/>Next</p><p>For i = 0 To minn1 Step 3<br/> zuobb(i + minn + 1) = zuobiao1(minn1 - i - 2)<br/> zuobb(i + minn + 2) = zuobiao1(minn1 - i - 1)<br/> zuobb(i + minn + 3) = zuobiao1(minn1 - i)<br/>Next<br/>ElseIf Sqr((zuobiao(0) - zuobiao1(0)) ^ 2 + (zuobiao(1) - zuobiao1(1)) ^ 2) _<br/>< Sqr((zuobiao(0) - zuobiao1(UBound(zuobiao1) - 2)) ^ 2 + (zuobiao(1) - zuobiao1(UBound(zuobiao1) - 1)) ^ 2) And Sqr((zuobiao(0) - zuobiao1(0)) ^ 2 + (zuobiao(1) - zuobiao1(1)) ^ 2) _<br/>< Sqr((zuobiao(UBound(zuobiao) - 2) - zuobiao1(0)) ^ 2 + (zuobiao(UBound(zuobiao) - 1) - zuobiao1(1)) ^ 2) Then<br/>For i = 0 To minn Step 3<br/> zuobb(i) = zuobiao(minn - i - 2)<br/> zuobb(i + 1) = zuobiao(minn - i - 1)<br/> zuobb(i + 2) = zuobiao(minn - i)<br/>Next</p><p>For i = 0 To minn1<br/> zuobb(i + minn + 1) = zuobiao1(i)<br/>Next</p><p>ElseIf Sqr((zuobiao(0) - zuobiao1(UBound(zuobiao1) - 2)) ^ 2 + (zuobiao(1) - zuobiao1(UBound(zuobiao1) - 1)) ^ 2) _<br/>< Sqr((zuobiao(0) - zuobiao1(0)) ^ 2 + (zuobiao(1) - zuobiao1(1)) ^ 2) And Sqr((zuobiao(0) - zuobiao1(UBound(zuobiao1) - 2)) ^ 2 + (zuobiao(1) - zuobiao1(UBound(zuobiao1) - 1)) ^ 2) _<br/>< Sqr((zuobiao(UBound(zuobiao) - 2) - zuobiao1(UBound(zuobiao1) - 2)) ^ 2 + (zuobiao(UBound(zuobiao) - 1) - zuobiao1(UBound(zuobiao1) - 1)) ^ 2) Then</p><p>For i = 0 To minn Step 3<br/> zuobb(i) = zuobiao(minn - i - 2)<br/> zuobb(i + 1) = zuobiao(minn - i - 1)<br/> zuobb(i + 2) = zuobiao(minn - i)<br/>Next</p><p>For i = 0 To minn1 Step 3<br/> zuobb(i + minn + 1) = zuobiao1(minn1 - i - 2)<br/> zuobb(i + minn + 2) = zuobiao1(minn1 - i - 1)<br/> zuobb(i + minn + 3) = zuobiao1(minn1 - i)<br/>Next</p><p>End If<br/>ThisDrawing.ActiveLayer = ThisDrawing.Layers(mysel(0).Layer)<br/>mysel(0).Delete<br/>mysel(1).Delete<br/>ThisDrawing.ModelSpace.Add3DPoly zuobb</p><p>ElseIf mysel(0).EntityType = 23 And mysel(1).EntityType = 23 Then<br/>zuobiao = mysel(0).Coordinates<br/>zuobiao1 = mysel(1).Coordinates<br/>minn = UBound(zuobiao)<br/>minn1 = UBound(zuobiao1)</p><p>ReDim zuobb(0 To minn + minn1 + 1) As Double<br/>If Sqr((zuobiao(UBound(zuobiao) - 2) - zuobiao1(0)) ^ 2 + (zuobiao(UBound(zuobiao) - 1) - zuobiao1(1)) ^ 2) _<br/>< Sqr((zuobiao(UBound(zuobiao) - 2) - zuobiao1(UBound(zuobiao1) - 2)) ^ 2 + (zuobiao(UBound(zuobiao) - 1) - zuobiao1(UBound(zuobiao1) - 1)) ^ 2) And Sqr((zuobiao(UBound(zuobiao) - 2) - zuobiao1(0)) ^ 2 + (zuobiao(UBound(zuobiao) - 1) - zuobiao1(1)) ^ 2) _<br/>< Sqr((zuobiao(0) - zuobiao1(0)) ^ 2 + (zuobiao(1) - zuobiao1(1)) ^ 2) Then<br/>For i = 0 To minn<br/> zuobb(i) = zuobiao(i)<br/>Next</p><p>For i = 0 To minn1<br/> zuobb(i + minn + 1) = zuobiao1(i)<br/>Next<br/>ElseIf Sqr((zuobiao(UBound(zuobiao) - 2) - zuobiao1(UBound(zuobiao1) - 2)) ^ 2 + (zuobiao(UBound(zuobiao) - 1) - zuobiao1(UBound(zuobiao1) - 1)) ^ 2) _<br/>< Sqr((zuobiao(UBound(zuobiao) - 2) - zuobiao1(0)) ^ 2 + (zuobiao(UBound(zuobiao) - 1) - zuobiao1(1)) ^ 2) And Sqr((zuobiao(UBound(zuobiao) - 2) - zuobiao1(UBound(zuobiao1) - 2)) ^ 2 + (zuobiao(UBound(zuobiao) - 1) - zuobiao1(UBound(zuobiao1) - 1)) ^ 2) _<br/>< Sqr((zuobiao(0) - zuobiao1(UBound(zuobiao1) - 2)) ^ 2 + (zuobiao(1) - zuobiao1(UBound(zuobiao1) - 1)) ^ 2) Then<br/>For i = 0 To minn<br/> zuobb(i) = zuobiao(i)<br/>Next</p><p>For i = 0 To minn1 Step 3<br/> zuobb(i + minn + 1) = zuobiao1(minn1 - i - 2)<br/> zuobb(i + minn + 2) = zuobiao1(minn1 - i - 1)<br/> zuobb(i + minn + 3) = zuobiao1(minn1 - i)<br/>Next<br/>ElseIf Sqr((zuobiao(0) - zuobiao1(0)) ^ 2 + (zuobiao(1) - zuobiao1(1)) ^ 2) _<br/>< Sqr((zuobiao(0) - zuobiao1(UBound(zuobiao1) - 2)) ^ 2 + (zuobiao(1) - zuobiao1(UBound(zuobiao1) - 1)) ^ 2) And Sqr((zuobiao(0) - zuobiao1(0)) ^ 2 + (zuobiao(1) - zuobiao1(1)) ^ 2) _<br/>< Sqr((zuobiao(UBound(zuobiao) - 2) - zuobiao1(0)) ^ 2 + (zuobiao(UBound(zuobiao) - 1) - zuobiao1(1)) ^ 2) Then<br/>For i = 0 To minn Step 3<br/> zuobb(i) = zuobiao(minn - i - 2)<br/> zuobb(i + 1) = zuobiao(minn - i - 1)<br/> zuobb(i + 2) = zuobiao(minn - i)<br/>Next</p><p>For i = 0 To minn1<br/> zuobb(i + minn + 1) = zuobiao1(i)<br/>Next</p><p>ElseIf Sqr((zuobiao(0) - zuobiao1(UBound(zuobiao1) - 2)) ^ 2 + (zuobiao(1) - zuobiao1(UBound(zuobiao1) - 1)) ^ 2) _<br/>< Sqr((zuobiao(0) - zuobiao1(0)) ^ 2 + (zuobiao(1) - zuobiao1(1)) ^ 2) And Sqr((zuobiao(0) - zuobiao1(UBound(zuobiao1) - 2)) ^ 2 + (zuobiao(1) - zuobiao1(UBound(zuobiao1) - 1)) ^ 2) _<br/>< Sqr((zuobiao(UBound(zuobiao) - 2) - zuobiao1(UBound(zuobiao1) - 2)) ^ 2 + (zuobiao(UBound(zuobiao) - 1) - zuobiao1(UBound(zuobiao1) - 1)) ^ 2) Then</p><p>For i = 0 To minn Step 3<br/> zuobb(i) = zuobiao(minn - i - 2)<br/> zuobb(i + 1) = zuobiao(minn - i - 1)<br/> zuobb(i + 2) = zuobiao(minn - i)<br/>Next</p><p>For i = 0 To minn1 Step 3<br/> zuobb(i + minn + 1) = zuobiao1(minn1 - i - 2)<br/> zuobb(i + minn + 2) = zuobiao1(minn1 - i - 1)<br/> zuobb(i + minn + 3) = zuobiao1(minn1 - i)<br/>Next</p><p>End If<br/>ThisDrawing.ActiveLayer = ThisDrawing.Layers(mysel(0).Layer)<br/>Set xuln = ThisDrawing.ModelSpace.AddPolyline(zuobb)<br/>xuln.Thickness = mysel(0).Thickness<br/>xuln.ConstantWidth = mysel(0).ConstantWidth<br/>xuln.Linetype = mysel(0).Linetype<br/>xuln.color = mysel(0).color<br/>xuln.Lineweight = mysel(0).Lineweight<br/>mysel(0).Delete<br/>mysel(1).Delete<br/>End If<br/>Else<br/>MsgBox "此方法限于两根线"<br/>End If<br/>If mysel.count <> 0 Then<br/>mysel.Delete<br/>End If<br/>we:<br/>End Sub</p>
chtd
发表于 2007-12-10 21:47:00
<p>Sub jbgh()‘-------------------------------曲线局部光滑<br/>On Error GoTo we<br/>Dim bzuo As Variant<br/>Dim mysel As AcadSelectionSet<br/>If ThisDrawing.SelectionSets.count = 0 Then<br/>Set mysel = ThisDrawing.SelectionSets.Add("mysel")<br/>AppActivate ThisDrawing.Application.Caption<br/>mysel.SelectOnScreen<br/>Else<br/>ThisDrawing.SelectionSets.Item(0).Delete<br/>Set mysel = ThisDrawing.SelectionSets.Add("mysel")<br/>AppActivate ThisDrawing.Application.Caption<br/>mysel.SelectOnScreen<br/>End If</p><p>ThisDrawing.ActiveLayer = ThisDrawing.Layers(mysel(0).Layer)<br/>ThisDrawing.SetVariable "OSMODE", 512<br/>'strs = ThisDrawing.Utility.GetString(0, "请输入线上每两点之间内插点的个数:")<br/>add1 = ThisDrawing.Utility.GetPoint(, "请输入起点:")<br/>add2 = ThisDrawing.Utility.GetPoint(add1, "请输入终点:")<br/>If mysel.count = 1 Then<br/>If mysel(0).EntityType = 2 Then '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>三维线<br/>bzuo = mysel(0).Coordinates<br/>For i = 0 To UBound(bzuo) - 3 Step 3<br/> dis1 = Sqr((bzuo(i) - bzuo(i + 3)) ^ 2 + (bzuo(i + 1) - bzuo(i + 4)) ^ 2)<br/> dis2 = Sqr((bzuo(i) - add1(0)) ^ 2 + (bzuo(i + 1) - add1(1)) ^ 2) + Sqr((bzuo(i + 3) - add1(0)) ^ 2 + (bzuo(i + 4) - add1(1)) ^ 2)<br/> If dis2 - dis1 <= 0.01 Then<br/> m = (i + 3) / 3<br/> End If<br/> dis1 = Sqr((bzuo(i) - bzuo(i + 3)) ^ 2 + (bzuo(i + 1) - bzuo(i + 4)) ^ 2)<br/> dis2 = Sqr((bzuo(i) - add2(0)) ^ 2 + (bzuo(i + 1) - add2(1)) ^ 2) + Sqr((bzuo(i + 3) - add2(0)) ^ 2 + (bzuo(i + 4) - add2(1)) ^ 2)<br/> If dis2 - dis1 <= 0.01 Then<br/> n = (i + 3) / 3<br/> End If<br/>Next</p><p>ReDim zuob(0 To (Val(strs) * (Abs(m - n) + 1)) * 3 + 3 * ((UBound(bzuo) + 1) / 3 - Abs(m - n) - 2) - 1) As Double<br/>If m > n Then<br/> lk = 0<br/> For j = 0 To UBound(bzuo) Step 3<br/> If j / 3 + 1 < n Then<br/> zuob(lk) = bzuo(j): zuob(lk + 1) = bzuo(j + 1): zuob(lk + 2) = bzuo(j + 2)<br/> lk = lk + 3<br/> ElseIf j / 3 + 1 >= n And j / 3 + 1 <= m Then<br/> For ll = 0 To strs - 1<br/> zuob(lk) = (ll + 1) * (bzuo((j + 3)) - bzuo(j)) / (strs + 1) + bzuo(j)<br/> zuob(lk + 1) = (ll + 1) * (bzuo(j + 4) - bzuo(j + 1)) / (strs + 1) + bzuo(j + 1)<br/> zuob(lk + 2) = (ll + 1) * (bzuo(j + 5) - bzuo(j + 2)) / (strs + 1) + bzuo(j + 2)<br/> lk = lk + 3<br/> Next<br/> ElseIf j / 3 + 1 > m + 1 Then<br/> zuob(lk) = bzuo(j): zuob(lk + 1) = bzuo(j + 1): zuob(lk + 2) = bzuo(j + 2)<br/> lk = lk + 3<br/> End If<br/> Next</p><p>ElseIf n > m Then<br/> lk = 0<br/> For j = 0 To UBound(bzuo) Step 3<br/> If j / 3 + 1 < m Then<br/> zuob(lk) = bzuo(j): zuob(lk + 1) = bzuo(j + 1): zuob(lk + 2) = bzuo(j + 2)<br/> lk = lk + 3<br/> ElseIf j / 3 + 1 >= m And (j + 1) / 3 <= n Then<br/> For ll = 0 To strs - 1<br/> zuob(lk) = (ll + 1) * (bzuo((j + 3)) - bzuo(j)) / (strs + 1) + bzuo(j)<br/> zuob(lk + 1) = (ll + 1) * (bzuo(j + 4) - bzuo(j + 1)) / (strs + 1) + bzuo(j + 1)<br/> zuob(lk + 2) = (ll + 1) * (bzuo(j + 5) - bzuo(j + 2)) / (strs + 1) + bzuo(j + 2)<br/> lk = lk + 3<br/> Next<br/> ElseIf j / 3 + 1 > n + 1 Then<br/> zuob(lk) = bzuo(j): zuob(lk + 1) = bzuo(j + 1): zuob(lk + 2) = bzuo(j + 2)<br/> lk = lk + 3<br/> End If<br/> Next</p><p>End If<br/>If mysel(0).Closed = True Then<br/>Set lne = ThisDrawing.ModelSpace.Add3DPoly(zuob)<br/>lne.Closed = True<br/>lne.Update<br/>Else<br/>Set lne = ThisDrawing.ModelSpace.Add3DPoly(zuob)<br/>End If<br/>mysel(0).Delete</p><p>ElseIf mysel(0).EntityType = 24 Then '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>二维线<br/>bzuo = mysel(0).Coordinates<br/>For i = 0 To UBound(bzuo) - 2 Step 2<br/> dis1 = Sqr((bzuo(i) - bzuo(i + 2)) ^ 2 + (bzuo(i + 1) - bzuo(i + 3)) ^ 2)<br/> dis2 = Sqr((bzuo(i) - add1(0)) ^ 2 + (bzuo(i + 1) - add1(1)) ^ 2) + Sqr((bzuo(i + 2) - add1(0)) ^ 2 + (bzuo(i + 3) - add1(1)) ^ 2)<br/> If dis2 - dis1 <= 0.01 Then<br/> m = (i + 2) / 2<br/> End If<br/> dis1 = Sqr((bzuo(i) - bzuo(i + 2)) ^ 2 + (bzuo(i + 1) - bzuo(i + 3)) ^ 2)<br/> dis2 = Sqr((bzuo(i) - add2(0)) ^ 2 + (bzuo(i + 1) - add2(1)) ^ 2) + Sqr((bzuo(i + 2) - add2(0)) ^ 2 + (bzuo(i + 3) - add2(1)) ^ 2)<br/> If dis2 - dis1 <= 0.01 Then<br/> n = (i + 2) / 2<br/> End If<br/>Next</p><p>ReDim zuob(0 To (Val(strs) * (Abs(m - n) + 1)) * 2 + 2 * ((UBound(bzuo) + 1) / 2 - Abs(m - n) - 2) - 1) As Double<br/>If m > n Then<br/> lk = 0<br/> For j = 0 To UBound(bzuo) Step 2<br/> If j / 2 + 1 < n Then<br/> zuob(lk) = bzuo(j): zuob(lk + 1) = bzuo(j + 1)<br/> lk = lk + 2<br/> ElseIf j / 2 + 1 >= n And j / 2 + 1 <= m Then<br/> For ll = 0 To strs - 1<br/> zuob(lk) = (ll + 1) * (bzuo((j + 2)) - bzuo(j)) / (strs + 1) + bzuo(j)<br/> zuob(lk + 1) = (ll + 1) * (bzuo(j + 3) - bzuo(j + 1)) / (strs + 1) + bzuo(j + 1)<br/> lk = lk + 2<br/> Next<br/> ElseIf j / 2 + 1 > m + 1 Then<br/> zuob(lk) = bzuo(j): zuob(lk + 1) = bzuo(j + 1)<br/> lk = lk + 2<br/> End If<br/> Next</p><p>ElseIf n > m Then<br/> lk = 0<br/> For j = 0 To UBound(bzuo) Step 2<br/> If j / 2 + 1 < m Then<br/> zuob(lk) = bzuo(j): zuob(lk + 1) = bzuo(j + 1)<br/> lk = lk + 2<br/> ElseIf j / 2 + 1 >= m And (j + 1) / 2 <= n Then<br/> For ll = 0 To strs - 1<br/> zuob(lk) = (ll + 1) * (bzuo((j + 2)) - bzuo(j)) / (strs + 1) + bzuo(j)<br/> zuob(lk + 1) = (ll + 1) * (bzuo(j + 3) - bzuo(j + 1)) / (strs + 1) + bzuo(j + 1)<br/> lk = lk + 2<br/> Next<br/> ElseIf j / 2 + 1 > n + 1 Then<br/> zuob(lk) = bzuo(j): zuob(lk + 1) = bzuo(j + 1)<br/> lk = lk + 2<br/> End If<br/> Next</p><p>End If<br/>bbg = mysel(0).Elevation<br/>If mysel(0).Closed = True Then<br/>Set lne = ThisDrawing.ModelSpace.AddLightWeightPolyline(zuob)<br/>lne.Closed = True<br/>lne.Elevation = bbg<br/>lne.Thickness = mysel(0).Thickness<br/>lne.ConstantWidth = mysel(0).ConstantWidth<br/>lne.Linetype = mysel(0).Linetype<br/>lne.color = mysel(0).color<br/>lne.Lineweight = mysel(0).Lineweight<br/>lne.Update<br/>Else<br/>Set lne = ThisDrawing.ModelSpace.AddLightWeightPolyline(zuob)<br/>lne.Elevation = bbg<br/>lne.Thickness = mysel(0).Thickness<br/>lne.ConstantWidth = mysel(0).ConstantWidth<br/>lne.Linetype = mysel(0).Linetype<br/>lne.color = mysel(0).color<br/>lne.Lineweight = mysel(0).Lineweight<br/>lne.Update<br/>End If<br/>mysel(0).Delete</p><p>End If<br/>If mysel.count <> 0 Then<br/> mysel.Delete<br/>End If<br/>ThisDrawing.SetVariable "OSMODE", 0<br/>End If<br/>we:<br/>End Sub</p>
chtd
发表于 2007-12-10 21:50:00
与大家交流分享，希望大家多提宝贵意见。
welcome0511
发表于 2008-1-17 18:36:00
这么多原码,没人支持,我来顶一下
caizhiming
发表于 2008-1-30 12:02:00
顶顶!!!
songzhao
发表于 2008-1-31 15:55:00
<p>不错很好谢谢楼主了</p>
ry888
发表于 2008-2-21 20:26:00
<p>不错</p>
xujinghai205
发表于 2008-3-14 15:36:00
<p>有种找到组织的感觉</p>
lxgyes
发表于 2008-3-16 07:52:00
ok