一个小小的问题深深的困扰着我。

llikk_love

     最近闲来无事，想做一个产状的图标，打算用块的做，（用直接画的方式已经成功），
但是由于Set ObjBlock = ThisDrawing.Blocks.Add(InsertPt, "产状图块")   这句命令的存在，导致每调用一次命令，产状图标都自动增加一个，想在代码最后加入删除这个块，用objblock.delete但是程序又显示失败，请哪位高手帮忙解答下，我搜过论坛里的帖子，好像零星有人碰到这个问题，但我好像没能理解各位达人的意思，估计自己还是个编程菜鸟。以下是代码，能解答或者不能解答的本人都将感激不尽。

llikk_love

2. Option Explicit
   
3. 
   
4. Private Sub CommandButton1_Click()
   
5. Dim ObjBlock As AcadBlock
   
6. Dim ObjLine As AcadLine
   
7. Dim ObjLine1 As AcadLine
   
8. Dim ObjLWPLine As AcadLWPolyline
   
9. 
   
10. Dim InsertPt(0 To 2) As Double
    
11. Dim PickPt As Variant
    
12. Dim pt1(0 To 2) As Double
    
13. Dim pt2(0 To 2) As Double
    
14. Dim pt3(0 To 2) As Double
    
15. Dim pt4(0 To 2) As Double
    
16. Dim pt5(0 To 2) As Double
    
17. Dim Points(0 To 3) As Double
    
18. 
    
19. Dim x As Double
    
20. Dim y As Double
    
21. 
    
22. frmMain.Hide
    
23. PickPt = ThisDrawing.Utility.GetPoint(, "获取第一点")
    
24. x = PickPt(0): y = PickPt(1)
    
25. InsertPt(0) = x: InsertPt(1) = y: InsertPt(2) = 0
    
26. pt1(0) = x: pt1(1) = y: pt1(2) = 0
    
27. pt2(0) = x + 4: pt2(1) = y: pt2(2) = 0
    
28. pt3(0) = x: pt3(1) = y - 5: pt3(2) = 0
    
29. pt4(0) = x: pt4(1) = y + 5: pt4(2) = 0
    
30. pt5(0) = x + 6: pt5(1) = y: pt5(2) = 0
    
31. Points(0) = x + 6: Points(1) = y
    
32. Points(2) = x + 4: Points(3) = y
    
33. 
    
34. Set ObjBlock = ThisDrawing.Blocks.Add(InsertPt, "产状图块")
    
35. Set ObjLine = ObjBlock.AddLine(pt1, pt2)
    
36. Set ObjLine1 = ObjBlock.AddLine(pt3, pt4)
    
37. Set ObjLWPLine = ObjBlock.AddLightWeightPolyline(Points)
    
38. ObjLWPLine.SetWidth 0, 0, 1.5
    
39. ObjLine.Lineweight = acLnWt030
    
40. ObjLine1.Lineweight = acLnWt030
    
41. ObjLine.color = acRed
    
42. ObjLine1.color = acRed
    
43. ObjLWPLine.color = acRed
    
44. 
    
45. Dim BlockInsertRef As AcadBlockReference
    
46. Set BlockInsertRef = ThisDrawing.ModelSpace.InsertBlock(InsertPt, "产状图块", 1, 1, 1, 0)
    
47. frmMain.Show
    
48. End Sub
    

Option Explicit<br /> <br /> Private Sub CommandButton1_Click()<br /> Dim ObjBlock As AcadBlock<br /> Dim ObjLine As AcadLine<br /> Dim ObjLine1 As AcadLine<br /> Dim ObjLWPLine As AcadLWPolyline<br /> <br /> Dim InsertPt(0 To 2) As Double<br /> Dim PickPt As Variant<br /> Dim pt1(0 To 2) As Double<br /> Dim pt2(0 To 2) As Double<br /> Dim pt3(0 To 2) As Double<br /> Dim pt4(0 To 2) As Double<br /> Dim pt5(0 To 2) As Double<br /> Dim Points(0 To 3) As Double<br /> <br /> Dim x As Double<br /> Dim y As Double<br /> <br /> frmMain.Hide<br /> PickPt = ThisDrawing.Utility.GetPoint(, "获取第一点")<br /> x = PickPt(0): y = PickPt(1)<br /> InsertPt(0) = x: InsertPt(1) = y: InsertPt(2) = 0<br /> pt1(0) = x: pt1(1) = y: pt1(2) = 0<br /> pt2(0) = x + 4: pt2(1) = y: pt2(2) = 0<br /> pt3(0) = x: pt3(1) = y - 5: pt3(2) = 0<br /> pt4(0) = x: pt4(1) = y + 5: pt4(2) = 0<br /> pt5(0) = x + 6: pt5(1) = y: pt5(2) = 0<br /> Points(0) = x + 6: Points(1) = y<br /> Points(2) = x + 4: Points(3) = y<br /> <br /> Set ObjBlock = ThisDrawing.Blocks.Add(InsertPt, "产状图块")<br /> Set ObjLine = ObjBlock.AddLine(pt1, pt2)<br /> Set ObjLine1 = ObjBlock.AddLine(pt3, pt4)<br /> Set ObjLWPLine = ObjBlock.AddLightWeightPolyline(Points)<br /> ObjLWPLine.SetWidth 0, 0, 1.5<br /> ObjLine.Lineweight = acLnWt030<br /> ObjLine1.Lineweight = acLnWt030<br /> ObjLine.color = acRed<br /> ObjLine1.color = acRed<br /> ObjLWPLine.color = acRed<br /> <br /> Dim BlockInsertRef As AcadBlockReference<br /> Set BlockInsertRef = ThisDrawing.ModelSpace.InsertBlock(InsertPt, "产状图块", 1, 1, 1, 0)<br /> frmMain.Show<br /> End Sub<br />

llikk_love

产状程序是vb6.0中写的，下面的代码是在cad vba中写的。哪位高人帮小弟个忙解答下。

liu_kunlun

制块之前，看块是否已存在
（遍历ThisDrawing.Blocks，看是否有块名相同的）

llikk_love

liu_kunlun 发表于 2012-1-18 20:03
制块之前，看块是否已存在
（遍历ThisDrawing.Blocks，看是否有块名相同的）

谢谢，已经解决了，呵呵，就是假如一个判断语句或者遍历语句，看此块是否存在。