江湖救急！

mshuser

雪山飞狐版主及众高手您们好：
本人学习了几年cad，但编程技术刚开始学，很菜。前几天看到一篇论文，很感兴趣（论文见附件），现求教：论文用vba扩展数据知识编写，只用1000及1001组码，看似简单但始终摸不到头绪，到最后用扩展数据替代表行块属性，不知怎么做。请版主及众高手在百忙之中帮我忙活一下，编出此程序，告诉我要点，感激不尽。先谢过大家及版主！ mshuser@sohu.com

雪山飞狐_lzh

要编制两个程序


第一个标注序号，并写入XData


第二个读取XData，生成明细表

mshuser

飞狐版主：


给我点源代码，好不好？多谢多谢！

雪山飞狐_lzh

源代码帮助里都有，：）


你可以试着编编，编不下去了，贴上来给大家批批

mshuser

飞狐版主： 这是我写的输入代码，请问如何加入扩展数据？ daihao.setxdata 1000,"daihao"这样不行吧？ Sub ShuRu()
Dim xuahao As Integer
Dim daihao As String
Dim mingcheng As String
Dim shuliang As Integer
Dim cailiao As String
Dim danjian As Double
Dim zongji As Double
Dim beizhu As String
xuahao = ThisDrawing.Utility.GetString(1, vbCrLf & "序号")
daihao = ThisDrawing.Utility.GetString(1, vbCrLf & "代号")
mingcheng = ThisDrawing.Utility.GetString(1, vbCrLf & "名称")
shuliang = ThisDrawing.Utility.GetString(1, vbCrLf & "数量")
cailiao = ThisDrawing.Utility.GetString(1, vbCrLf & "材料")
danjian = ThisDrawing.Utility.GetString(1, vbCrLf & "单件重量")
zongji = ThisDrawing.Utility.GetString(1, vbCrLf & "总重量")
beizhu = ThisDrawing.Utility.GetString(1, vbCrLf & "备注")
End Sub

雪山飞狐_lzh

看看帮助里的例子：

Sub Example_SetXdata()
			 ' This example creates a line and attaches extended data to that line.
			 
			 ' Create the line
			 Dim lineObj As AcadLine
			 Dim startPt(0 To 2) As Double, endPt(0 To 2) As Double
			 startPt(0) = 1#: startPt(1) = 1#: startPt(2) = 0#
			 endPt(0) = 5#: endPt(1) = 5#: endPt(2) = 0#
			 Set lineObj = ThisDrawing.ModelSpace.AddLine(startPt, endPt)
			 ZoomAll

			 ' Initialize all the xdata values. Note that first data in the list should be
			 ' application name and first datatype code should be 1001
			 Dim DataType(0 To 9) As Integer
			 Dim Data(0 To 9) As Variant
			 Dim reals3(0 To 2) As Double
			 Dim worldPos(0 To 2) As Double
			 
			 DataType(0) = 1001: Data(0) = "Test_Application"
			 DataType(1) = 1000: Data(1) = "This is a test for xdata"

			 DataType(2) = 1003: Data(2) = "0"																		 ' layer
			 DataType(3) = 1040: Data(3) = 1.23479137438413E+40	 ' real
			 DataType(4) = 1041: Data(4) = 1237324938											 ' distance
			 DataType(5) = 1070: Data(5) = 32767																 ' 16 bit Integer
			 DataType(6) = 1071: Data(6) = 32767																 ' 32 bit Integer
			 DataType(7) = 1042: Data(7) = 10																			 ' scaleFactor

			 reals3(0) = -2.95: reals3(1) = 100: reals3(2) = -20
			 DataType(8) = 1010: Data(8) = reals3															 ' real
			 
			 worldPos(0) = 4: worldPos(1) = 400.99999999: worldPos(2) = 2.798989
			 DataType(9) = 1011: Data(9) = worldPos													 ' world space position
			 
			 ' Attach the xdata to the line
			 lineObj.SetXData DataType, Data
			 
			 ' Return the xdata for the line
			 Dim xdataOut As Variant
			 Dim xtypeOut As Variant
			 lineObj.GetXData "", xtypeOut, xdataOut
			 
End Sub	 

mshuser

版主好：
看过帮助还有问题：如何定义序号的图元对象？定义为何种类型？怎样给其赋值？
如版主对此程序已胸有成竹，还望将编程思路讲讲，不吝赐教。再次叩谢！

efan2000

序号可以使用块对象，其实就是零件号吧。当插入序号时，要求用户输入材料的各项数据，同时将之后的序号推后一个数，当删除序号时，将之前的序号前移一个数。最后按序号的顺序生成明细表。

mshuser

请版主不要烦：还有问题：


1。可不可以插入一个在cad中做的图块？我看过郑工的《vba开发精彩实例教程>


好像利用objetdbx，太复杂了，有简单的方法吗？


2。论文中的两个图块在vba中做还是在cad中作？


3。天涯孤客斑竹的意思是定义“序号”为一块对象，再将文字对象添加到序号图块中？是这样吗？

雪山飞狐_lzh

你可以在cad中做一个属性块，Vba里调用InsertBlock方法插入，再用SetXData方法附加扩展数据