属性块的使用-CAD-VBA源码

OptionExplicit'´´½¨Ò»¸ö´øÓÐÊôÐԵĿéPublicSubCreateAttBlk()DimptBase(0To2)AsDoubleptBase(0)=0:ptBase(1)=0:ptBase(2)=0'Ìí¼Ó¿é¶¨ÒåDimobjBlkDefAsAcadBlockSetobjBlkDef=ThisDrawing.Blocks.Add(ptBase,ÊôÐÔ¿é)'Ïò¿é¶¨ÒåÖÐÌí¼ÓͼÐζÔÏóDimpt1(0To2)AsDoubleDimpt2(0To2)AsDoublept1(0)=-10:pt1(1)=0:pt1(2)=0pt2(0)=10:pt2(1)=0:pt2(2)=0objBlkDef.AddLinept1,pt2pt1(0)=0:pt1(1)=-10:pt1(2)=0pt2(0)=0:pt2(1)=10:pt2(2)=0objBlkDef.AddLinept1,pt2objBlkDef.AddCircleptBase,6objBlkDef.AddAttribute5,0,ÊäÈë²åÈëµã×ø±ê:,ptBase,²åÈëµã×ø±ê,CStr((100,100))EndSub'²åÈë´øÊôÐԵĿéPublicSubInsertAttBlk()'²åÈë¿éDimobjBlkRefAsAcadBlockReferenceDimptInsert(0To2)AsDoubleptInsert(0)=100:ptInsert(1)=100:ptInsert(2)=0SetobjBlkRef=ThisDrawing.ModelSpace.InsertBlock(ptInsert,ÊôÐÔ¿é,1,1,1,0)ZoomAll'»ñµÃ¿é²ÎÕÕµÄÊôÐÔDimvarAttributesAsVariantvarAttributes=objBlkRef.GetAttributesvarAttributes(0).TextString=(200,200)EndSub