剖面线问题

yingxunxue

此图是我刚才传上去的.请问如何使用 "须保证填充边界的封闭，相交不行，可以用SendCommand发送-boundary命令求填充边界或直接调用－Hactch命令按点填充" 填充左视图中几条弧和周围所封闭的地方

sjsfsdrgy

各位高手，我是初学者，你们发表的思路很难看懂，希望大家高抬贵手帮助我写个程序:),解决剖面线的问题。我的毕业设计只剩下这个问题不会，谢谢各位！！！

雪山飞狐_lzh

2. Sub Test()
3.        Dim pMax As Variant
4.        Dim pnt(2) As Double, dot(2) As Double
5.        Dim pBlock As AcadBlock, pObj As AcadBlockReference, pEntity(0) As AcadEntity
6.        Dim pOut(0) As AcadEntity, pHatch As AcadHatch
7.        Dim pLine As AcadLine
8.        Set pBlock = ThisDrawing.Blocks.Add(pnt, "*U")
9.        Dim p1(2) As Double, p2(2) As Double, p3(2) As Double
10.        p2(0) = 10: p3(1) = 10
11.        Set pLine = ThisDrawing.ModelSpace.AddLine(p1, p2)
12.        Application.ZoomExtents
13.        Application.ZoomPrevious
14.        pLine.Delete
15.        pMax = ThisDrawing.GetVariable("EXTMAX")
16.        pMax(0) = pMax(0) + 2
17.        pMax(1) = pMax(1) + 2
18.        pBlock.AddLine p1, p2
19.        pBlock.AddLine p1, p3
20.        pBlock.AddLine p2, p3
21.        pBlock.AddCircle p1, 1
22.        dot(0) = pMax(0): dot(1) = pMax(1)
23.        Set pObj = ThisDrawing.ModelSpace.InsertBlock(pMax, pBlock.Name, 1, 1, 1, 0)
24.        Application.ZoomExtents
25.        pMax(0) = pMax(0) + 2
26.        pMax(1) = pMax(1) + 2
27.        ThisDrawing.SendCommand "-Boundary" & vbCr & pMax(0) & "," & pMax(1) & vbCr & vbCr
28.        Set pEntity(0) = ThisDrawing.ModelSpace(ThisDrawing.ModelSpace.Count - 1)
29.        ThisDrawing.CopyObjects pEntity, pBlock
30.        Set pOut(0) = pBlock(pBlock.Count - 1)
31.        pOut(0).Move dot, p1
32.        pEntity(0).Delete
33.        pObj.Delete
34.        Application.ZoomPrevious
35.        Set pHatch = pBlock.AddHatch(0, "Ansi31", True)
36.        pHatch.AppendOuterLoop (pOut)
37.        pHatch.Evaluate
38.        pOut(0).Delete
39.        Set pObj = ThisDrawing.ModelSpace.InsertBlock(ThisDrawing.Utility.GetPoint, pBlock.Name, 1, 1, 1, 0)
40. End Sub

Sub Test()        Dim pMax As Variant        Dim pnt(2) As Double, dot(2) As Double        Dim pBlock As AcadBlock, pObj As AcadBlockReference, pEntity(0) As AcadEntity        Dim pOut(0) As AcadEntity, pHatch As AcadHatch        Dim pLine As AcadLine        Set pBlock = ThisDrawing.Blocks.Add(pnt, "*U")        Dim p1(2) As Double, p2(2) As Double, p3(2) As Double        p2(0) = 10: p3(1) = 10        Set pLine = ThisDrawing.ModelSpace.AddLine(p1, p2)        Application.ZoomExtents        Application.ZoomPrevious        pLine.Delete        pMax = ThisDrawing.GetVariable("EXTMAX")        pMax(0) = pMax(0) + 2        pMax(1) = pMax(1) + 2        pBlock.AddLine p1, p2        pBlock.AddLine p1, p3        pBlock.AddLine p2, p3        pBlock.AddCircle p1, 1        dot(0) = pMax(0): dot(1) = pMax(1)        Set pObj = ThisDrawing.ModelSpace.InsertBlock(pMax, pBlock.Name, 1, 1, 1, 0)        Application.ZoomExtents        pMax(0) = pMax(0) + 2        pMax(1) = pMax(1) + 2        ThisDrawing.SendCommand "-Boundary" & vbCr & pMax(0) & "," & pMax(1) & vbCr & vbCr        Set pEntity(0) = ThisDrawing.ModelSpace(ThisDrawing.ModelSpace.Count - 1)        ThisDrawing.CopyObjects pEntity, pBlock        Set pOut(0) = pBlock(pBlock.Count - 1)        pOut(0).Move dot, p1        pEntity(0).Delete        pObj.Delete        Application.ZoomPrevious        Set pHatch = pBlock.AddHatch(0, "Ansi31", True)        pHatch.AppendOuterLoop (pOut)        pHatch.Evaluate        pOut(0).Delete        Set pObj = ThisDrawing.ModelSpace.InsertBlock(ThisDrawing.Utility.GetPoint, pBlock.Name, 1, 1, 1, 0) End Sub

yingxunxue

"EXTMAX"是和何变量

雪山飞狐_lzh

yingxunxue发表于2004-5-19 9:29:00\"EXTMAX\"是和何变量

把我给的两个链接看完

yingxunxue

谢谢老兄,还有很多的问题要你们帮忙,因为我在用VB(VBA)开发一个CAD系统,很多方面如果有技巧的话,希望提供帮助,.


如果我先画了若干条线段(包括圆弧) ,而且又是动态的组成(封闭)的,请问我用什么方法填充-----------我现在的做法是去捕捉各个端点(我不是用AddLightWeightPolyline画的），重新用AddLightWeightPolyline画一圈，再填充．请问合理吗？


图中绿色线围成的封闭区域，特别上俩条弧围成的封闭区域

sjsfsdrgy

谢谢"雪山飞狐",你的程序很重要,我会认真的从零开始学习,以后程序中不懂的地方还请多多帮忙解释:),还有个问题:


我定义线形时,不知道为什么出错,是不是路径的问题?我把AUTOCAD2002装C盘Program Files文件,,在程序中写C:\Program Files\AutoCAD2002\support\acad.lin.


还有其他出错的可能吗?

雪山飞狐_lzh

程序思路:


1/在求边界之前做块的试插入,关键要判断插入点没有其他图元与试插入的块参照干涉,(可以考虑将其他层锁定)


2/按-Boundary命令求边界时必须保证边界在Zoom内,即看得见


3/边界是ModelSpace最后一个实体,用CopyObjects复制到块内


4/在块内按边界填充

sjsfsdrgy

如果两部分剖面线的方向不同，该怎样处理？






Sendcommand和Boundary属于那一部分，可以在哪个课本中找到，我要学习.

雪山飞狐_lzh

sjsfsdrgy发表于2004-5-19 13:06:00如果两部分剖面线的方向不同，该怎样处理？ Sendcommand和Boundary属于那一部分，可以在哪个课本中找到，我要学习.

两部分剖面线的方向,生成两个HatchObject