;;;当前AutoCAD任务中的顶层AutoCAD应用程序对象
(Vlax-Get-Acad-Object)
(Setq acadObject (Vlax-Get-Acad-Object))
(Setq objACad (Vlax-Get-Acad-Object))
(or *ACAD* (Setq *ACAD* (Vlax-Get-Acad-Object)))
;;;当前活动文档
(Vla-Get-ActiveDocument (Vlax-Get-Acad-Object))
(Setq acadDocument (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument))
(Setq acadDoc (Vla-Get-ActiveDocument (Vlax-Get-Acad-Object)))
(Setq ThisDrawing (Vla-Get-ActiveDocument (Vlax-Get-Acad-Object)))
(or *AcadDoc* (Setq *AcadDoc* (Vla-Get-ActiveDocument (Vlax-Get-Acad-Object))))
;;;当前活动布局
(Vla-Get-ActiveLayout (Vla-Get-ActiveDocument (Vlax-Get-Acad-Object)))
(Setq activeLayout (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'ActiveLayout ))
(Setq cLayout (vla-get-activeLayout (Vla-Get-ActiveDocument (Vlax-Get-Acad-Object))))
;;;模型空间对象
(Vla-Get-ModelSpace (Vla-Get-ActiveDocument (Vlax-Get-Acad-Object)))
(Setq mSpace (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'ModelSpace ))
(Setq *ModelSpace* (Vlax-Get (Vla-Get-ActiveDocument (Vlax-Get-Acad-Object)) 'ModelSpace))
;;;图纸空间对象
(Vla-Get-PaperSpace (Vla-Get-ActiveDocument (Vlax-Get-Acad-Object)))
(Setq pSpace (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'PaperSpace ))
;;;当前文档标注样式的集合
(Setq DimStyles (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'DimStyles ))
;;;当前文档图层的集合
(Setq Layers (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'Layers ))
;;;当前文档线型的集合
(Setq Linetypes (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'Linetypes ))
;;;当前文档文字样式的集合
(Setq textStylesObj (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'TextStyles ))
(Setq TextStyles (vla-get-TextStyles (Vla-Get-ActiveDocument (Vlax-Get-Acad-Object))))
;;;当前文档块定义的集合
(Setq blocks (vla-get-blocks (Vla-Get-ActiveDocument (Vlax-Get-Acad-Object))))
(Setq *Blocks* (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))))
;;;已知文字样式名称，获取该文字样式对象
(Setq textStyleObj (Vlax-Invoke-Method (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'TextStyles) 'Item "Ecidi_romans"))
;;;已知图层名称，获取该图层对象
(Setq LayObj (Vlax-Invoke-Method (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'Layers) 'Item "0"))
;;;已知某图层对象LayObj，获取该图层的名称
(vla-get-name LayObj)
(Setq LayerName (Vlax-Get LayObj 'Name))
;;;已知文字样式对象名，获取字体文件、大字体文件
(Setq fontFile (Vlax-Get textStyleObj 'fontFile))
(Setq BigFontFile (Vlax-Get textStyleObj 'BigFontFile))
;;;获取应用程序或文档的名称，包括路径。
(Setq fullName (vlax-get (Vla-Get-ActiveDocument (Vlax-Get-Acad-Object)) 'FullName))
(getvar "DWGPREFIX")
(getvar "dwgname")
;;;DWGPREFIX：存储图形的驱动器和文件夹前缀
;;;DWGNAME：存储当前图形的名称
;;;建立选择集，且筛选图元类型——单行文字、直线、轻量多段线
(Setq ss (ssget '((0 . "TEXT,LINE,LWPOLYLINE"))))
;;;已知VLA对象名obj，获取句柄handle
(Setq handle (Vlax-Get obj 'Handle ))
;;;已知多段线VLA对象名plineObj，获取其顶点二维坐标表plineCoordinates
(Setq plineCoordinates (Vlax-Get plineObj 'Coordinates ))
(vl-remove-if '(lambda (x) (/= (car x) 10)) (entget (car (entSeL "\nSel Pline"))))
(mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget (car (entSeL "\nSel Pline")))))
;;;获取图元类型
(Setq szEntType (cdr (assoc 0 (entget (car (entSeL))))));;返回值为一个字符串
(Setq szObjName (Vlax-Get (Vlax-Ename->Vla-Object (car (entSeL))) 'ObjectName));;返回值为一个字符串
(Setq nEntType (Vlax-Get (Vlax-Ename->Vla-Object (car (entSeL))) 'EntityType));;返回值为一个整数，(= AcText 32)的返回值为T
;;;《AutoCAD VBA开发精彩实例教程》（张帆 郑立楷 王华杰 编著）86页：
;;;要判断实体的对象类型，既可以使用ObjectName属性，又可以使用EntityType属性。如果使用ObjectName属性，它的取值是ARX中对应的类的名称，一般来说，是对象的类型加上AcDb前缀；如果使用EntityType属性（该属性在VBA中无法获得帮助信息，但是确实能够使用，对它的使用方法，并未获得权威资料的考证），一般来说可以在对象的类型前面加上Ac前缀。
;;;修改单行文字对象的文字样式
(Vlax-Put-Property (Vlax-Ename->Vla-Object (car (entSeL))) 'StyleName "Ecidi_romans" );;返回值为nil
;;;获取单行文字对象的高度
(Setq rTextHeight (Vlax-Get (Vlax-Ename->Vla-Object (car (entSeL))) 'Height ))
;;;获取单行文字对象的宽度比例
(Setq rScaleFactor (Vlax-Get (Vlax-Ename->Vla-Object (car (entSeL))) 'ScaleFactor ))
;;;改单行文字对象的文字样式
(Vlax-Put-Property (Vlax-Ename->Vla-Object (car (entSeL))) 'StyleName (getVar "Ecidi_romans") )
;;;改单行文字对象的内容
(Vlax-Put-Property objText 'TextString "王二狗的春天666")
;;;改单行文字对象的颜色
(Vlax-Put-Property objText 'Color 1 )
;;;改单行文字对象的对正方式
(Vlax-Put-Property objText 'Alignment 10 )
;;;Alignment 对正 justifytext命令对正选项
;;;acAlignmentLeft 0 基线左对齐 L
;;;acAlignmentCenter 1 基线居中 C
;;;acAlignmentRight 2 基线右对齐 R
;;;acAlignmentAligned 3 对齐 A
;;;acAlignmentMiddle 4 中间 M
;;;acAlignmentFit 5 布满 F
;;;acAlignmentTopLeft 6 左上 TL
;;;acAlignmentTopCenter 7 中上 TC
;;;acAlignmentTopRight 8 右上 TR
;;;acAlignmentMiddleLeft 9 左中 ML
;;;acAlignmentMiddleCenter 10 正中 MC
;;;acAlignmentMiddleRight 11 右中 MR
;;;acAlignmentBottomLeft 12 左下 BL
;;;acAlignmentBottomCenter 13 中下 BC
;;;acAlignmentBottomRight 14 右下 BR
;对齐到 acAlignmentLeft 的文字使用 InsertionPoint 属性来放置文字。
;对齐到 acAlignmentAligned 或 acAlignmentFit 的文字同时使用 InsertionPoint 以及 TextAlignmentPoint 属性来放置文字。
;对齐到其它任何位置的文字使用 TextAlignmentPoint 属性来放置文字。
;;;改单行文字对象的对齐点
(Vlax-Put-Property objText 'TextAlignmentPoint (vlax-3D-point (List 0.0 0.0 0.0)) )
;;;改单行文字对象的插入点
(Vlax-Put-Property (Vlax-Ename->Vla-Object (car (entSeL))) 'InsertionPoint (vlax-3D-point pt) )
;;;改多行文字对象的宽度
(Vlax-Put-Property (Vlax-Ename->Vla-Object (car (entSeL))) 'Width 60.0 )
;;;改多行文字的定义高度
(entMod (subSt (cons 46 21.0) (assoc 46 (entGet (Setq ename (car (entSeL)) ))) (entGet ename)))
;;;获取圆对象的圆心
(Setq LstCenter (cdr (assoc 10 (entget (car (entSeL))))));返回值为一个三维圆心坐标表
(Setq variantCenter (Vla-Get-Center circleObj));返回值类型为变体，(vlax-safeArray->List (vlax-variant-value (Vla-Get-Center (vlax-ename->vla-object (car (entSeL))))))
(Setq LstCenter (Vlax-Get circleObj 'Center));返回值为一个三维圆心坐标表
;;;遍历块定义中每个图元/对象
(vlax-for obj (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) "块名")
(Setq szObjectName (Vlax-Get obj 'ObjectName ));获取对象的AutoCAD类名
(cond
((= "AcDbAttributeDefinition" szObjectName);属性
(vla-put-color obj 1);颜色
(vla-put-Layer obj "Defpoints");图层
(vla-put-Alignment obj acAlignmentMiddleCenter);正中对正
(vla-put-TextAlignmentPoint obj (vlax-3d-point (List 417.5 2.5 0.0)));对齐点
(Vlax-Put-Property obj 'StyleName "仿宋-WD" );文字样式
(Vlax-Put-Property obj 'ScaleFactor 0.75 );宽度比例
)
)
)
;;;遍历当前文档块定义的集合，获取每个块定义的名称，并存入表blockNameLst中
(Setq blocks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
(Setq blockNameLst niL)
(vlax-for block blocks
(Setq blockName (Vlax-Get block 'Name ))
(Setq blockNameLst (append blockNameLst (list blockName)))
)
;;;当前文档中块定义的个数
(Vlax-Get (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'Blocks) 'Count )
;;;第i个块定义对象
(Vlax-Invoke-Method (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'Blocks) 'item i)
;;;第i个块定义对象的名称
(Vlax-Get (Vlax-Invoke-Method (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'Blocks) 'item i) 'Name )
(vla-get-name (Vlax-Invoke-Method (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'Blocks) 'item i))
;;;创建块定义（含多段线图框外框、多段线图框内框、多段线图签外框、表示比例的属性），插入块参照
;;00.定义参数
(Setq rDrawingRatio 100.0 )
;;块表记录
;;01.图纸内块表记录(AcDbBlockTableRecord)集合(包括ModelSpace和所有PaperSpace以及用户定义的块表记录)
(Setq *Blocks* (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))))
;;02.创建可用的块名
(Setq blockNameStr (rtos (getVar "cDate") 2 8))
;;03.块表记录集合中新增块表记录(AcDbBlockTableRecord)blockNameStr
(vla-add *Blocks* (vlax-3D-point '(0 0 0)) blockNameStr)
;;04.根据块表记录名获取块表记录对象
(Setq newBlockTableRecordObject (vla-Item *Blocks* blockNameStr))
;;;3.定义矩形的四个角点 (左下, 右下, 右上, 左上)
;;这里示例创建一个 420×297 的矩形，左下角在(0, 0)
(Setq p1 (List 0.0 0.0)) ; 左下角
(Setq p2 (List 420.0 0.0)) ; 右下角
(Setq p3 (List 420.0 297.0)); 右上角
(Setq p4 (List 0.0 297.0)) ; 左上角
;;4.关键步骤：将点列表转换为符合ActiveX要求的扁平化数组
;;AddLightweightPolyline 需要一个变体(Variant)，包含一个双精度(Double)数组
(Setq pointsArray (vlax-make-safeArray vlax-vbDouble (cons 0 (1- (* 4 2)))));4个点 * 2个坐标(XY) = 8个元素
(Setq pointsArray1 (vlax-make-safeArray vlax-vbDouble (cons 0 (1- (* 4 2)))))
(Setq pointsArray2 (vlax-make-safeArray vlax-vbDouble (cons 0 (1- (* 4 2)))))
(vlax-safeArray-fiLL pointsArray
(List (car p1) (cadr p1) ; 点1 X,Y
(car p2) (cadr p2) ; 点2 X,Y
(car p3) (cadr p3) ; 点3 X,Y
(car p4) (cadr p4) ; 点4 X,Y
)
)
(Setq p1 (List 15.0 10.0) p2 (List 410.0 10.0) p3 (List 410.0 287.0) p4 (List 15.0 287.0))
(vlax-safeArray-fiLL pointsArray1 (List (car p1) (cadr p1) (car p2) (cadr p2) (car p3) (cadr p3) (car p4) (cadr p4)))
(Setq p1 (List 335.0 10.0) p2 (List 410.0 10.0) p3 (List 410.0 (/ 182.5 3.0)) p4 (List 335.0 (/ 182.5 3.0)))
(vlax-safeArray-fiLL pointsArray2 (List (car p1) (cadr p1) (car p2) (cadr p2) (car p3) (cadr p3) (car p4) (cadr p4)))
;;05.在新增的块表记录中新增三个矩形对象
;;创建矩形（轻量多段线）
(Setq objFrameOuter (vla-addLightweightPolyline newBlockTableRecordObject (vlax-make-variant pointsArray)))
(Setq objFrameInner (vla-addLightweightPolyline newBlockTableRecordObject (vlax-make-variant pointsArray1)))
(Setq objFrameSign (vla-addLightweightPolyline newBlockTableRecordObject (vlax-make-variant pointsArray2)))
;;6.闭合多段线，使其成为真正的矩形（如果不闭合，只是一条多段线）
(vla-put-Closed objFrameOuter :vlax-true)
(vla-put-Closed objFrameInner :vlax-true)
(vla-put-Closed objFrameSign :vlax-true)
;;06.在新增的块表记录中新增一个单行文字属性对象
(Setq nDrawingRatio (atoi (rtos rDrawingRatio 2)) )
(Setq newTextAttributeObject (vla-AddAttribute newBlockTableRecordObject 6 acAttributeModeVerify "比例" (vlax-3D-point '(415 5 0)) "Scale" (itoa nDrawingRatio)));字高为6，提示为"比例"，标记为"Scale"，值为(itoa nDrawingRatio)
(vla-put-color newTextAttributeObject 1);颜色
(vla-put-Layer newTextAttributeObject "Defpoints");图层
(vla-put-Alignment newTextAttributeObject acAlignmentMiddleCenter);正中对正
(vla-put-TextAlignmentPoint newTextAttributeObject (vlax-3d-point (List 415.0 5.0 0.0)));对齐点
(Vlax-Put-Property newTextAttributeObject 'StyleName "仿宋-2H" );文字样式
(Vlax-Put-Property newTextAttributeObject 'ScaleFactor 0.75 );宽度比例
;;插入块参照
;;在模型空间中插入之前定义的块表记录（块定义）为块参照(用块表记录名→即块名来插入)
(Setq *ModelSpace* (vlax-get (vla-get-ActiveDocument (vlax-get-acad-object)) 'ModelSpace))
(vla-InsertBlock *ModelSpace* (vlax-3D-point insPt) blockNameStr nDrawingRatio nDrawingRatio nDrawingRatio 0)
(Setq blkEnt (entLast));块参照的图元名
(Setq obj (vlax-ename->vla-object blkEnt));块参照的对象名
浙公网安备 33010602011771号