乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
楼主: Draftek

偏移多段线

[复制链接]

71

主题

928

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1230
发表于 2007-2-26 12:54:41 | 显示全部楼层
谢谢你,Draftek
我确实需要这个,但它返回错误消息
你能修复它并上传吗
非常感谢你帮助我。
回复

使用道具 举报

15

主题

109

帖子

6

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
169
发表于 2007-3-6 23:33:03 | 显示全部楼层
我处理闭合多边形,因此您可能需要调整代码,使其处理多个顶点
该代码偏移多段线。返回区域(如果较大或较小)也会告诉您垂直方向
  1. Public Function DirPolSante(polyEnt As AcadEntity) As String
  2. Dim OffsetObj As Variant
  3. Dim AreaObj As Double
  4. Dim AreaOffset As Double
  5. AreaObj = polyEnt.Area
  6. OffsetObj = polyEnt.Offset(0.01)
  7. AreaOffset = OffsetObj(0).Area
  8. OffsetObj(0).Delete
  9. If AreaOffset  numBulge Then
  10.             newbulge(numBulge - idx) = polyEnt.GetBulge(idx) * -1
  11.             
  12.             Else
  13.             
  14.             newbulge(0) = polyEnt.GetBulge(idx) * -1
  15.             
  16.           End If
  17.         Next idx
  18.         
  19. 'reverse the original pline
  20.         polyEnt.Coordinates = newcoord
  21.         
  22.         For idx = 0 To numBulge
  23.         
  24.           If idx = 0 Then
  25.             polyEnt.SetBulge (numBulge), newbulge(idx)
  26.           Else
  27.             polyEnt.SetBulge (idx - 1), newbulge(idx)
  28.           End If
  29.             
  30.         Next idx
  31.         
  32.         polyEnt.Update
  33. End Sub
这将LW多段线转换为;二维多段线。当您必须在代码末尾使用2D多边形时,非常适合较旧的CNC程序。ACAD在LW多段线上使用Pedit做得更好(sendcommand):
  1. Public Function polyentconvert(polyEnt As Object) As AcadPolyline
  2. Dim entity As AcadDocument
  3. Set entity = AutoCAD_Application.ActiveDocument
  4. Dim I As Integer, j As Integer, K As Integer
  5. If polyEnt.EntityName = "AcDbPolyline" Then
  6.   Dim Coords As Variant
  7.   Coords = polyEnt.Coordinates
  8.   I = Fix((UBound(Coords) + 1) * 1.5) - 1
  9.   ReDim Coords2(I) As Double
  10.   j = 0
  11.   Dim X As Double, y As Double, z As Double
  12.   For I = LBound(Coords) To UBound(Coords) Step 2
  13.     X = Coords(I): y = Coords(I + 1): z = 0#
  14.     Coords2(j) = X:
  15.     Coords2(j + 1) = y:
  16.     Coords2(j + 2) = z:
  17.     j = j + 3
  18.   Next I
  19.   Dim Coords2V As Variant
  20.   Coords2V = Coords2
  21.   Dim EN2 As AcadPolyline
  22.   Set EN2 = entity.ModelSpace.AddPolyline(Coords2V)
  23.   EN2.Closed = polyEnt.Closed
  24.   EN2.Color = polyEnt.Color
  25.   EN2.Linetype = polyEnt.Linetype
  26.   EN2.Thickness = polyEnt.Thickness
  27.     EN2.Layer = polyEnt.Layer
  28.   Dim b As Double, w As Double, W2 As Double
  29.   For I = 0 To UBound(Coords) Step 2
  30.     j = I / 2
  31.     b = polyEnt.GetBulge(j)
  32.     polyEnt.GetWidth j, w, W2
  33.     EN2.SetBulge j, b
  34.     EN2.SetWidth j, w, W2
  35.   Next I
  36.   Dim polyentx As AcadPolyline
  37.   Set polyentx = EN2
  38.   polyEnt.Delete
  39. End If
  40. End Function
这段代码的大部分都可以贡献给Malcom Fernadaz。他的代码使用开放多段线。我修改了它来处理封闭的
回复

使用道具 举报

15

主题

109

帖子

6

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
169
发表于 2007-3-15 15:44:03 | 显示全部楼层
非常感谢你,Davew!
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-7-7 14:11 , Processed in 1.425873 second(s), 56 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表