[求助]有关块方面的问题

Michael527 发表于 2005-2-20 19:46:00

我采用图块方式编的一个程序，运行时，第一次很正常，第二次以后都要多生成一些莫明其妙的图块，为什么？如何解决？谢谢！

mccad 发表于 2005-2-20 22:04:00

你的图块已经存在，再以同名的块名肯定会有问题。

Michael527 发表于 2005-2-21 19:42:00

那如何解决呢？谢谢明总！

雪山飞狐_lzh 发表于 2005-2-21 21:21:00

你的代码呢?

Michael527 发表于 2005-2-24 19:38:00

我的代码为：

Private Sub cmdDraw_Click() Dim objEllipse1 As AcadEllipse Dim objEllipse2 As AcadEllipse Dim linea, lineb, linec, lined, linee, linef, lineg As AcadLine Dim ptCen(0 To 2) As Double, radRatio1, radRatio2 As Double Dim pt1(0 To 2) As Double, pt2(0 To 2) As Double, sca As Double Dim pt3(0 To 2) As Double, pt4(0 To 2) As Double Dim pt5(0 To 2) As Double, pt6(0 To 2) As Double Dim pt7(0 To 2) As Double, pt8(0 To 2) As Double Dim pt9(0 To 2) As Double, pt10(0 To 2) As Double Dim pt11(0 To 2) As Double, pt12(0 To 2) As Double Dim ptmajAxis1(0 To 2) As Double, ptmajAxis2(0 To 2) As Double Dim CenPt As Variant, OldCmdEcho As Variant OldCmdEcho = ThisDrawing.GetVariable("cmdecho") Dim objLayer As AcadLayer OldLayer = ThisDrawing.GetVariable("clayer") Set objLayer = ThisDrawing.Layers.Add("1轮廓实线层") ThisDrawing.ActiveLayer = objLayer frmHD.Hide

sca = cboSc.Text deg = (cboDeg.Text * 3.1415926) / 180 CenPt = ThisDrawing.Utility.GetPoint(, "输入中心点：") 

pt1(0) = CenPt(0) - D / 2 * sca pt1(1) = CenPt(1) pt1(2) = CenPt(2)

pt2(0) = CenPt(0) - D / 2 * sca pt2(1) = CenPt(1) + H pt2(2) = CenPt(2)

pt3(0) = CenPt(0) + D / 2 * sca pt3(1) = CenPt(1) + H pt3(2) = CenPt(2)

pt4(0) = CenPt(0) + D / 2 * sca pt4(1) = CenPt(1) pt4(2) = CenPt(2)

pt5(0) = CenPt(0) - D / 2 * sca - t * sca pt5(1) = CenPt(1) pt5(2) = CenPt(2)

pt6(0) = CenPt(0) - D / 2 * sca - t * sca pt6(1) = CenPt(1) + H pt6(2) = CenPt(2)

pt7(0) = CenPt(0) + D / 2 * sca + t * sca pt7(1) = CenPt(1) + H pt7(2) = CenPt(2)

pt8(0) = CenPt(0) + D / 2 * sca + t * sca pt8(1) = CenPt(1) pt8(2) = CenPt(2)

pt9(0) = CenPt(0) pt9(1) = CenPt(1) - 5 * sca pt9(2) = CenPt(2)

pt10(0) = CenPt(0) pt10(1) = CenPt(1) + (H + h1 + t + 5) * sca pt10(2) = CenPt(2)

pt11(0) = CenPt(0) - D / 2 * sca - t * sca - 5 * sca pt11(1) = CenPt(1) + H pt11(2) = CenPt(2)

pt12(0) = CenPt(0) + D / 2 * sca + t * sca + 5 * sca pt12(1) = CenPt(1) + H pt12(2) = CenPt(2)

ptmajAxis1(0) = D / 2 * sca ptmajAxis1(1) = 0 ptmajAxis1(2) = 0 radRatio1 = 0.5

ptmajAxis2(0) = (D / 2 + t) * sca ptmajAxis2(1) = 0 ptmajAxis2(2) = 0 radRatio2 = (h1 + t) / (D / 2 + t)

 ptCen(0) = CenPt(0) ptCen(1) = CenPt(1) + H * sca ptCen(2) = CenPt(2) Dim FT As String FT = "Head" Set blockObj = ThisDrawing.Blocks.Add(CenPt, FT)

Set objEllipse1 = blockObj.AddEllipse(ptCen, ptmajAxis1, radRatio1) objEllipse1.StartAngle = 0 objEllipse1.EndAngle = 3.1415926

Set objEllipse2 = blockObj.AddEllipse(ptCen, ptmajAxis2, radRatio2) objEllipse2.StartAngle = 0 objEllipse2.EndAngle = 3.1415926

 Set linea = blockObj.AddLine(pt1, pt2) Set lineb = blockObj.AddLine(pt3, pt4) Set linec = blockObj.AddLine(pt5, pt6) Set lined = blockObj.AddLine(pt7, pt8) Set linee = blockObj.AddLine(pt5, pt8)

Set objLayer = ThisDrawing.Layers.Add("3中心线层") ThisDrawing.ActiveLayer = objLayer Set linef = blockObj.AddLine(pt9, pt10) Set lineg = blockObj.AddLine(pt11, pt12)

Set objLayer = ThisDrawing.Layers.Add("0") ThisDrawing.ActiveLayer = objLayer

Dim blockRefObj As AcadBlockReference Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(CenPt, FT, sca, sca, sca, deg)

ThisDrawing.Regen acActiveViewport

Set blockRefObj = Nothing Set blockObj = Nothing Unload Me ThisDrawing.SetVariable "cmdecho", OldCmdEcho ThisDrawing.SetVariable "clayer", OldLayer End Sub

第一次使用VB，请不要见笑，谢谢！

Michael527 发表于 2005-2-25 00:48:00

没有高手可以指点吗？遗憾！

mccad 发表于 2005-2-25 12:31:00

Dim FT As String
FT = "Head"
Set blockObj = ThisDrawing.Blocks.Add(CenPt, FT)问题就在以上这句。
如果块本身已经存在，则使用这一句是不能将块清空的。所以在后继的程序中向块中添加图元则是添加到原先已经存在的块中。所以会造成块中图元的重复。
解决的方法是，在添加块前先判断该名称的块是否存在，如果存在，则需要用其它名称。
对于自己编程的程序中使用到的块，最好使用一些统一前缀的名称，而且名称长一些，这样可以避免与其它人编程的程序中的块重复，影响自己程序的运行。如果是在调试过程中，则可以通过新建文件再调试。

Michael527 发表于 2005-2-25 18:41:00

谢谢明总指点！送你一朵鲜花！

桃花小妖 发表于 2005-9-28 10:40:00

我的问题和你的一样
我想知道你是怎么解决的
谢谢

页: [1]

明经CAD社区's Archiver

[求助]有关块方面的问题