从分解块挤出区域
好的，我'；我把头发拔出来，我试图从一个区域创建一个挤出的实体，这是一个分解块。（我的想法是绘制区域，并将其作为块插入，然后分解块，留下可以挤出的区域。）；我应该试试这个，还是用折线代替 ；我想我可以根据单个拾取点的坐标绘制一条多段线，但这似乎太多了。或者我可以将块从一个区域更改为一条多段线，并将其挤出吗 ；无论如何，当我试图捕捉爆炸的方块时，我崩溃了 ；有办法做到这一点吗？我从其他代码开始，因此所有注释行Public Sub DrawWideFlangeSteel()
Dim oCyl As Acad3DSolid, oCircle As AcadCircle, oLine As AcadLine, oLayer As AcadLayer
Dim oBeam As Acad3DSolid, oReg As AcadRegion, oBlock As AcadBlockReference, oObject As AcadObject
Dim varpick As Variant
Dim Ent As AcadEntity
Dim Inspt As Variant
Dim RegEnt(0) As AcadEntity
Dim V(2) As Double, Unit As Double, Vn(2) As Double, dblBusDia As Double
Dim P1, P2
Dim newPT1 As Variant
Dim newPT2 As Variant
Set oLayer = ThisDrawing.Layers.Add("3D-BUSS-STEEL")
oLayer.color = 235
Inspt = ThisDrawing.Utility.GetPoint(, "Pick Insertion Point: ")
If ThisDrawing.ActiveSpace = acModelSpace Then
Set oBlock = ThisDrawing.ModelSpace.InsertBlock(Inspt, "M:\MODEL-COMPONENTS\w8x24.dwg", 1#, 1#, 1#, 0)
Else
Set oBlock = ThisDrawing.PaperSpace.InsertBlock(Inspt, "M:\MODEL-COMPONENTS\w8x24.dwg", 1#, 1#, 1#, 0)
End If
ThisDrawing.Regen acActiveViewport
Set oObject = oBlock.Explode
' ThisDrawing.Utility.GetEntity Ent, varpick
' If Not TypeOf Ent Is AcadLine Then
' MsgBox "That was not a Layout Line"
' Exit Sub
' End If
' Set oLine = Ent
' newPT1 = oLine.StartPoint
' newPT2 = oLine.EndPoint
' newPT1(2) = ConvertFeet(frmInsPart.cboBusHeight.Value)
' newPT2(2) = ConvertFeet(frmInsPart.cboBusHeight.Value)
' Set oLine = ThisDrawing.ModelSpace.AddLine(newPT1, newPT2)
' oLine.Layer = "3D-BUSS-CALC"
' P1 = oLine.StartPoint: P2 = oLine.EndPoint
' V(0) = P2(0) - P1(0): V(1) = P2(1) - P1(1): V(2) = P2(2) - P1(2)
'Normalise the vector(It's length=1)
' Unit = Sqr(V(0) * V(0) + V(1) * V(1) + V(2) * V(2))
' Vn(0) = V(0) / Unit: Vn(1) = V(1) / Unit: Vn(2) = V(2) / Unit
' dblBusDia = CDbl(frmInsPart.cboBusSize.Value + 0.5) / 2
' Set oCircle = ThisDrawing.ModelSpace.AddCircle(oLine.StartPoint, dblBusDia)
ThisDrawing.Regen acActiveViewport
' oCircle.Normal = Vn ' Vn or V both work here.
' ThisDrawing.Regen acActiveViewport
' Set RegEnt(0) = oCircle
' oReg = ThisDrawing.ModelSpace.AddRegion(RegEnt)
' Set oCyl = ThisDrawing.ModelSpace.AddExtrudedSolid(oReg(0), oLine.Length, 0)
' oCircle.Delete
' oReg(0).Delete
End Sub
哇，好了，深呼吸，放松……好了，现在不'；感觉好多了吗
好的，既然你回来了，要不要再试一次？画、插入、分解、挤出……你能解释一下为什么你'；我想这样做？你的意图是什么
要获取分解对象的对象，请将newObjs作为变量进行Dim。爆炸；在这个块中只有一个对象将oEntity Dim oEntity作为AcadEntity设置oEntity=newObjs（0），当我编写这个时，你发布了基本上回答了我问题的代码……但请注意我是如何得到分解区域的。。。。。。。 是的，非常感谢。好的，长话短说，我正在创建一个三维变电站设计工具，这将有助于在三维中绘制一个变电站，并弹出一个BOM表等等 ；我用的是8“；我的大多数钢支架都使用钢管，但有时我们使用宽翼缘梁作为支架 ；一旦完成，我将把它张贴在这里，供任何有兴趣在现实世界中测试/使用的人使用。 这是我出错的地方吗 ；我需要一个变体来捕捉爆炸的东西 ；我试着将oSomething作为AcadObject。爆炸'；t工作 是的，那'；就是这样。它将是块中对象的数组。 对不起，指挥官，我想你的主要问题在你身上；t要在非XY WCS平面中创建区域，首先创建区域，然后在所需的法线中旋转它，尽管我可能错了；J#039~ 谢谢杰夫，我知道这是可以做到的，我就是做不到；找不到那条信息 好的，既然我已经开始了这个线程，我想我可以在这里继续 ；上面的代码都是固定的，工作得很好 ；我有一个新问题，我正在分别创建3个三维实体，并希望将它们结合在一起
Public Sub AddDeadEnd(PhSpace As Double, PoleSp As Double, PoleHt As Double, BmHt As Double)
Const VK_ESCAPE = &H1B
Const VK_LBUTTON = &H1
Const VK_SPACE = &H20
Const VK_RETURN = &HD
Const VK_LEFT = &H25
On Err GoTo err_control
Dim inspt As Variant, dblRotation As Double, dblTOC As Double, leftLeg As Variant, rightLeg As Variant
Dim oCurrLayeR As AcadLayer, intAutoSnap As Integer, intOSMode As Integer, PI As Double, LL2 As Variant
Dim oPline As AcadLWPolyline, oEntity(0) As AcadEntity, regent(0) As AcadEntity, obj3d As Acad3DSolid
Dim objRegion
Set oCurrLayeR = ThisDrawing.ActiveLayer
'IsSetup
dblTOC = CDbl(InputBox("What is T.O.C. elevation? ie 12 or 0 or -12"))
ThisDrawing.SetVariable "ORTHOMODE", 1
intAutoSnap = ThisDrawing.GetVariable("AUTOSNAP")
ThisDrawing.SetVariable "AUTOSNAP", 0
intOSMode = ThisDrawing.GetVariable("OSMODE")
ThisDrawing.SetVariable "OSMODE", 32
inspt = ThisDrawing.Utility.GetPoint(, "Select Deadend Insertion Point: ")
ThisDrawing.SetVariable "OSMODE", 512
dblRotation = ThisDrawing.Utility.GetAngle(inspt, "Pick Line Direction: ")
PI = Atn(1) * 4
ThisDrawing.SetVariable "OSMODE", 0
inspt(2) = inspt(2) + dblTOC
leftLeg = ThisDrawing.Utility.PolarPoint(inspt, dblRotation - ((PI * 90) / 180), PoleSp / 2)
rightLeg = ThisDrawing.Utility.PolarPoint(inspt, dblRotation + ((PI * 90) / 180), PoleSp / 2)
Call LayerSet("3D-STEL", 235)
DrawDeadendPole leftLeg, PoleHt
DrawDeadendPole rightLeg, PoleHt
leftLeg(2) = leftLeg(2) + BmHt
Set oPline = ThisDrawing.ModelSpace.AddLightWeightPolyline(PolygonVexs(leftLeg, 8, 5))
oPline.Closed = True
oPline.Elevation = BmHt
oPline.Update
Set regent(0) = oPline
objRegion = ThisDrawing.ModelSpace.AddRegion(regent)
Set obj3d = ThisDrawing.ModelSpace.AddExtrudedSolid(objRegion(0), PoleSp, 0)
regent(0).Delete
objRegion(0).Delete
LL2 = ThisDrawing.Utility.PolarPoint(leftLeg, dblRotation, 12)
obj3d.Rotate3D leftLeg, LL2, ((PI * -90) / 180)
Exit_Here:
ThisDrawing.ActiveLayer = oCurrLayeR
ThisDrawing.SetVariable "AUTOSNAP", intAutoSnap
ThisDrawing.SetVariable "OSMODE", intOSMode
ThisDrawing.SetVariable "INSUNITS", 1
Exit Sub
err_control:
Select Case Err.Number
Case -2147352567
'Debug.Print Err.Number, Err.Description
varcancel = ThisDrawing.GetVariable("LASTPROMPT")
If InStr(1, varcancel, "*Cancel*")0 Then
If GetAsyncKeyState(VK_ESCAPE) And 8000 > 0 Then
Err.Clear
Resume Exit_Here
ElseIf GetAsyncKeyState(VK_LBUTTON) > 0 Then
Err.Clear
Resume
End If
Else
If GetAsyncKeyState(VK_SPACE) Then
Resume Exit_Here
End If
'Missed the pick, send them back!
Err.Clear
Resume
End If
Case Else
MsgBox Err.Description
Resume Exit_Here
End Select
End Sub DrawDeadendPole leftLeg和Right leg是前两个3d对象，您可以在代码底部看到第三个
代码是Private Sub DrawDeadendPole(insptpole As Variant, PoleHt As Double)
Dim dblBase As Double, dblTop As Double, dblHeight As Double
Dim obj3d As Acad3DSolid, regent(0) As AcadEntity
Dim oPline As AcadLWPolyline
Dim cenPt As Variant, iNum As Integer, intAutoSnap As Integer
Dim dblAng As Double, dblRad As Double, dblAngle As Double
Dim objRegion
dblHeight = PoleHt
dblTop = 18 / 2
dblAngle = Atn((dblTop - dblBase) / dblHeight)
iNum = 12
cenPt = insptpole
dblRad = 29 / 2
Set oPline = ThisDrawing.ModelSpace.AddLightWeightPolyline(PolygonVexs(cenPt, iNum, dblRad))
oPline.ConstantWidth = 0
oPline.Layer = "0"
oPline.Closed = True
oPline.Update
Set regent(0) = oPline
objRegion = ThisDrawing.ModelSpace.AddRegion(regent)
Set obj3d = ThisDrawing.ModelSpace.AddExtrudedSolid(objRegion(0), dblHeight, dblAngle)
regent(0).Delete
objRegion(0).Delete
ThisDrawing.Regen acActiveViewport
End Sub
Function PolygonVexs(cenPt As Variant, iNum As Integer, _
dblRad As Double, Optional mode As Integer = 0) As Variant
Dim tmpPt As Variant
Dim iCnt As Integer
Dim vCnt As Integer
Dim vxCnt As Integer
Dim PI As Double
PI = Atn(1) * 4
Dim dltAng As Double
Dim dblAng As Double
Dim initAng As Double
dltAng = 2 * PI / iNum
initAng = dltAng / 2
vxCnt = 2 * iNum - 1
iCnt = 0
vCnt = 0
ReDim ptsarr(0 To vxCnt) As Double
If mode = 0 Then dblRad = dblRad / Cos(dltAng / 2)
While iCnt < iNum
dblAng = initAng + dltAng * iCnt
tmpPt = ThisDrawing.Utility.PolarPoint(cenPt, dblAng, dblRad)
iCnt = iCnt + 1
ptsarr(vCnt) = tmpPt(0): ptsarr(vCnt + 1) = tmpPt(1)
vCnt = vCnt + 2
Wend
PolygonVexs = ptsarr
End Function
无论如何，问题是如何在创建三维实体以稍后使用布尔并集时捕捉它们 我尝试将DrawDeadendPole设置为函数，并使用Set 3dobj=drawDeadeEndPole，但没有'；t工作 ；我可能做错了，或者没有#039；t从正确的实体开始 ；本人'；我想这就是我要走的路，我只是#039；我还没弄明白。
页:
[1]
2