VisualLisp若干常用代码

;;;当前AutoCAD任务中的顶层AutoCAD应用程序对象
(Vlax-Get-Acad-Object)
(Setq acadObject (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))

;;;当前的布局
(Vla-Get-ActiveLayout (Vla-Get-ActiveDocument (Vlax-Get-Acad-Object)))
(Setq activeLayout (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'ActiveLayout ))

;;;模型空间对象
(Vla-Get-ModelSpace (Vla-Get-ActiveDocument (Vlax-Get-Acad-Object)))
(Setq mSpace (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) '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 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 textHeight (Vlax-Get (Vlax-Ename->Vla-Object (car (entsel))) 'Height ))

;;;获取单行文字对象的宽度比例
(setq scaleFactor (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 txtObjName 'TextString "99初名機工888株式会社99")

;;;改单行文字对象的颜色
(Vlax-Put-Property txtObjName 'Color 42 )

;;;改单行文字对象的对正方式
(Vlax-Put-Property txtObjName 'Alignment 4 )
;;;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 txtObjName 'TextAlignmentPoint (vlax-3D-point midPt) )

;;;改单行文字对象的插入点
(Vlax-Put-Property (Vlax-Ename->Vla-Object (car (entsel))) 'InsertionPoint (vlax-3D-point pt) )

;;;获取圆对象的圆心
(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))) "块名")
    ...
)

;;;遍历当前文档块定义的集合，获取每个块定义的名称，并存入表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))