Andresig 发表于 2022-7-6 22:10:50

向中的多段线添加尺寸标注

我开始一个例行程序,添加尺寸的折线。。。
 
问题是,它是在直线上创建的,我想将其与直线分开创建,如果有人能帮助我,这将是非常棒的。。。
 
谢谢
 
Sub add_dim_polyline()
   'to add Panel Dimensions
   Dim ThePolyline As AcadLWPolyline
   Dim polyCoords As Variant
   Dim getPoint As Variant
   Dim a As Integer
   Dim polyCoordBound As Integer
   Dim stPoint(2) As Double
   Dim ePoint(2) As Double
   Dim sectionAngle As Double
   Dim textCoords As Variant
   Dim polyDist As Double
   Dim x1, x2, y1, y2 As Double
   Dim objDimAligned As AcadDimAligned
   ThisDrawing.Utility.GetEntity ThePolyline, getPoint, "Select an object"
   polyCoords = ThePolyline.Coordinates
   polyCoordBound = UBound(polyCoords)



   For a = 0 To polyCoordBound - 1 Step 2
       If a = polyCoordBound - 1 Then
         stPoint(0) = polyCoords(a)
         stPoint(1) = polyCoords(a + 1)
         stPoint(2) = 0
         ePoint(0) = polyCoords(0)
         ePoint(1) = polyCoords(1)
         ePoint(2) = 0
       Else
         stPoint(0) = polyCoords(a)
         stPoint(1) = polyCoords(a + 1)
         stPoint(2) = 0
         ePoint(0) = polyCoords(a + 2)
         ePoint(1) = polyCoords(a + 3)
         ePoint(2) = 0

       End If
       x1 = stPoint(0): x2 = ePoint(0)
       y1 = stPoint(1): y2 = ePoint(1)
       polyDist = Sqr(((x1 - x2) ^ 2) + ((y1 - y2) ^ 2))
       sectionAngle = ThisDrawing.Utility.AngleFromXAxis(stPoint, ePoint)
       textCoords = ThisDrawing.Utility.PolarPoint(stPoint, sectionAngle, polyDist / 2)
       Set objDimAligned = ThisDrawing.ModelSpace.AddDimAligned(stPoint, ePoint, textCoords)

   Next a
End Sub

SEANT 发表于 2022-7-6 22:21:29

可能与这里显示的加法类似。
 
sectionAngle = ThisDrawing.Utility.AngleFromXAxis(stPoint, ePoint)
textCoords = ThisDrawing.Utility.PolarPoint(stPoint, sectionAngle, polyDist / 2)
textCoords = ThisDrawing.Utility.PolarPoint(textCoords, sectionAngle + 1.57, 1#) 'Rotate PI/2
Set objDimAligned = ThisDrawing.ModelSpace.AddDimAligned(stPoint, ePoint, textCoords)

Andresig 发表于 2022-7-6 22:24:00

Sub add_dim_polyline()
   'to add Panel Dimensions
   Dim ThePolyline As AcadLWPolyline
   Dim polyCoords As Variant
   Dim getPoint As Variant
   Dim a As Integer
   Dim polyCoordBound As Integer
   Dim stPoint(2) As Double
   Dim ePoint(2) As Double
   Dim sectionAngle As Double
   Dim textCoords As Variant
   Dim polyDist As Double
   Dim x1, x2, y1, y2 As Double
   Dim objDimAligned As AcadDimAligned
   Dim textAngle As Double
   ThisDrawing.Utility.GetEntity ThePolyline, getPoint, "Select an object"
   polyCoords = ThePolyline.Coordinates
   polyCoordBound = UBound(polyCoords)



   For a = 0 To polyCoordBound - 2 Step 2
       stPoint(0) = polyCoords(a)
       stPoint(1) = polyCoords(a + 1)
       stPoint(2) = 0
       ePoint(0) = polyCoords(a + 2)
       ePoint(1) = polyCoords(a + 3)
       ePoint(2) = 0

       x1 = stPoint(0): x2 = ePoint(0)
       y1 = stPoint(1): y2 = ePoint(1)
       polyDist = Sqr(((x1 - x2) ^ 2) + ((y1 - y2) ^ 2))
       sectionAngle = ThisDrawing.Utility.AngleFromXAxis(stPoint, ePoint)
       textAngle = sectionAngle + 1.57
       textCoords = ThisDrawing.Utility.PolarPoint(stPoint, sectionAngle + 1.57, 1#)
       Set objDimAligned = ThisDrawing.ModelSpace.AddDimAligned(stPoint, ePoint, textCoords)

   Next a
End Sub

goldy2000 发表于 2022-7-6 22:29:09

嘿,我刚刚看到这个帖子,你们中有人能告诉我这个VBA是关于什么的吗??绘制多段线时,它显示并写入直线或….的距离。。??

SEANT 发表于 2022-7-6 22:33:52

实际上,例程的结构是选择一条多段线并自动向其添加尺寸。

goldy2000 发表于 2022-7-6 22:39:39

听起来不错,我有一些类似的lisp,你们选择多段线,它把尺寸放在上面(在pline上的两个点之间,等等),你们如何使用VBA??从来没有这样做过,所以我很好奇。。。简单来说,如果你有时间写下如何开始。。

Andresig 发表于 2022-7-6 22:48:38

 
我仍然不被允许在地址上盖章,但在谷歌上搜索“autocad vba”,并将出现一些带有vba介绍的hyperpics.com页面

goldy2000 发表于 2022-7-6 22:53:27

 
好的,理解。。。Thx人!!!

iyant 发表于 2022-7-6 22:56:25

此代码无法工作,

MSasu 发表于 2022-7-6 23:00:25

欢迎来到论坛,Iyant!
你能说得更具体一点吗?你是如何加载/调用代码的?你收到错误信息了吗?最后,但并非最不重要的是,您试图在哪个版本中测试它?
页: [1] 2
查看完整版本: 向中的多段线添加尺寸标注