一个小小的问题深深的困扰着我。
最近闲来无事，想做一个产状的图标，打算用块的做，（用直接画的方式已经成功），但是由于Set ObjBlock = ThisDrawing.Blocks.Add(InsertPt, "产状图块") 这句命令的存在，导致每调用一次命令，产状图标都自动增加一个，想在代码最后加入删除这个块，用objblock.delete但是程序又显示失败，请哪位高手帮忙解答下，我搜过论坛里的帖子，好像零星有人碰到这个问题，但我好像没能理解各位达人的意思，估计自己还是个编程菜鸟。以下是代码，能解答或者不能解答的本人都将感激不尽。
Option Explicit
Private Sub CommandButton1_Click()
Dim ObjBlock As AcadBlock
Dim ObjLine As AcadLine
Dim ObjLine1 As AcadLine
Dim ObjLWPLine As AcadLWPolyline
Dim InsertPt(0 To 2) As Double
Dim PickPt As Variant
Dim pt1(0 To 2) As Double
Dim pt2(0 To 2) As Double
Dim pt3(0 To 2) As Double
Dim pt4(0 To 2) As Double
Dim pt5(0 To 2) As Double
Dim Points(0 To 3) As Double
Dim x As Double
Dim y As Double
frmMain.Hide
PickPt = ThisDrawing.Utility.GetPoint(, "获取第一点")
x = PickPt(0): y = PickPt(1)
InsertPt(0) = x: InsertPt(1) = y: InsertPt(2) = 0
pt1(0) = x: pt1(1) = y: pt1(2) = 0
pt2(0) = x + 4: pt2(1) = y: pt2(2) = 0
pt3(0) = x: pt3(1) = y - 5: pt3(2) = 0
pt4(0) = x: pt4(1) = y + 5: pt4(2) = 0
pt5(0) = x + 6: pt5(1) = y: pt5(2) = 0
Points(0) = x + 6: Points(1) = y
Points(2) = x + 4: Points(3) = y
Set ObjBlock = ThisDrawing.Blocks.Add(InsertPt, "产状图块")
Set ObjLine = ObjBlock.AddLine(pt1, pt2)
Set ObjLine1 = ObjBlock.AddLine(pt3, pt4)
Set ObjLWPLine = ObjBlock.AddLightWeightPolyline(Points)
ObjLWPLine.SetWidth 0, 0, 1.5
ObjLine.Lineweight = acLnWt030
ObjLine1.Lineweight = acLnWt030
ObjLine.color = acRed
ObjLine1.color = acRed
ObjLWPLine.color = acRed
Dim BlockInsertRef As AcadBlockReference
Set BlockInsertRef = ThisDrawing.ModelSpace.InsertBlock(InsertPt, "产状图块", 1, 1, 1, 0)
frmMain.Show
End Sub
产状程序是vb6.0中写的，下面的代码是在cad vba中写的。哪位高人帮小弟个忙解答下。 制块之前，看块是否已存在
（遍历ThisDrawing.Blocks，看是否有块名相同的） liu_kunlun 发表于 2012-1-18 20:03 static/image/common/back.gif
制块之前，看块是否已存在
（遍历ThisDrawing.Blocks，看是否有块名相同的）
谢谢，已经解决了，呵呵，就是假如一个判断语句或者遍历语句，看此块是否存在。
页:
[1]