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

Michael527

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

mccad

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

Michael527

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

雪山飞狐_lzh

你的代码呢?

Michael527

我的代码为： 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

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

mccad

2. Dim FT As String
3. FT = "Head"
4. Set blockObj = ThisDrawing.Blocks.Add(CenPt, FT)

Dim FT As String FT = "Head" Set blockObj = ThisDrawing.Blocks.Add(CenPt, FT)

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

Michael527

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

桃花小妖

我的问题和你的一样

我想知道你是怎么解决的

谢谢