VisualLisp若干常用代码

1 ;;;当前AutoCAD任务中的顶层AutoCAD应⽤程序对象 2 (Vlax-Get-Acad-Object)

3 (Setq acadObject (Vlax-Get-Acad-Object)) 4

5 ;;;当前的⽂档

6 (Vla-Get-ActiveDocument (Vlax-Get-Acad-Object))

7 (Setq acadDocument (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument)) 8

9 ;;;当前的布局

10 (Vla-Get-ActiveLayout (Vla-Get-ActiveDocument (Vlax-Get-Acad-Object)))

11 (Setq activeLayout (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'ActiveLayout )) 12

13 ;;;模型空间对象

14 (Vla-Get-ModelSpace (Vla-Get-ActiveDocument (Vlax-Get-Acad-Object)))

15 (Setq mSpace (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'ModelSpace )) 16

17 ;;;图纸空间对象

18 (Vla-Get-PaperSpace (Vla-Get-ActiveDocument (Vlax-Get-Acad-Object)))

19 (Setq pSpace (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'PaperSpace )) 20

21 ;;;当前⽂档标注样式的集合

22 (Setq DimStyles (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'DimStyles )) 23

24 ;;;当前⽂档图层的集合

25 (Setq Layers (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'Layers )) 26

27 ;;;当前⽂档线型的集合

28 (Setq Linetypes (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'Linetypes )) 29

30 ;;;当前⽂档⽂字样式的集合

31 (Setq textStylesObj (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'TextStyles )) 32

33 ;;;当前⽂档块定义的集合

34 (setq blocks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))) 35

36 ;;;已知⽂字样式名称，获取该⽂字样式对象

37 (Setq textStyleObj (Vlax-Invoke-Method (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'TextStyles) 'Item \"Ecidi_romans\")) 38

39 ;;;已知图层名称，获取该图层对象

40 (Setq LayObj (Vlax-Invoke-Method (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'Layers) 'Item \"0\")) 41

42 ;;;已知某图层对象LayObj，获取该图层的名称 43 (vla-get-name LayObj)

44 (Setq LayerName (Vlax-Get LayObj 'Name)) 45

46 ;;;已知⽂字样式对象名，获取字体⽂件、⼤字体⽂件 47 (Setq fontFile (Vlax-Get textStyleObj 'fontFile))

48 (Setq BigFontFile (Vlax-Get textStyleObj 'BigFontFile)) 49

50 ;;;获取应⽤程序或⽂档的名称，包括路径。

51 (setq fullName (vlax-get (Vla-Get-ActiveDocument (Vlax-Get-Acad-Object)) 'FullName)) 52 (getvar \"DWGPREFIX\") 53 (getvar \"dwgname\")

54 ;;;DWGPREFIX：存储图形的驱动器和⽂件夹前缀 55 ;;;DWGNAME：存储当前图形的名称 56

57 ;;;建⽴选择集，且筛选图元类型

58 (setq ss (ssget '((0 . \"TEXT,LINE,LWPOLYLINE\")))) 59

60 ;;;已知VLA对象名obj，获取句柄handle 61 (setq handle (Vlax-Get obj 'Handle )) 62

63 ;;;已知多段线VLA对象名plineObj，获取其顶点⼆维坐标表plineCoordinates 64 (Setq plineCoordinates (Vlax-Get plineObj 'Coordinates ))

65 (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget (car (entsel \"\\nSel Pline\"))))

66 (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget (car (entsel \"\\nSel Pline\"))))) 67

68 ;;;获取图元类型

69 (setq szEntType (cdr (assoc 0 (entget (car (entsel))))));;返回值为⼀个字符串

70 (setq szObjName (Vlax-Get (Vlax-Ename->Vla-Object (car (entsel))) 'ObjectName));;返回值为⼀个字符串

71 (setq nEntType (Vlax-Get (Vlax-Ename->Vla-Object (car (entsel))) 'EntityType));;返回值为⼀个整数，(= AcText 32)的返回值为T 72 ;;;《AutoCAD VBA开发精彩实例教程》（张帆 郑⽴楷 王华杰 编著）86页：

73 ;;;要判断实体的对象类型，既可以使⽤ObjectName属性，⼜可以使⽤EntityType属性。如果使⽤ObjectName属性，它的取值是ARX中对应的类的名称，⼀般来说，是对象的类型加上AcDb前缀；如果使⽤EntityType属性（该属性在VBA中⽆法获 74

75 ;;;修改单⾏⽂字对象的⽂字样式

76 (Vlax-Put-Property (Vlax-Ename->Vla-Object (car (entsel))) 'StyleName \"Ecidi_romans\" );;返回值为nil 77

78 ;;;获取单⾏⽂字对象的⾼度

79 (setq textHeight (Vlax-Get (Vlax-Ename->Vla-Object (car (entsel))) 'Height )) 80

81 ;;;获取单⾏⽂字对象的宽度⽐例

82 (setq scaleFactor (Vlax-Get (Vlax-Ename->Vla-Object (car (entsel))) 'ScaleFactor )) 83

84 ;;;改单⾏⽂字对象的⽂字样式

85 (Vlax-Put-Property (Vlax-Ename->Vla-Object (car (entsel))) 'StyleName (getvar \"Ecidi_romans\") ) 86

87 ;;;改单⾏⽂字对象的内容

88 (Vlax-Put-Property txtObjName 'TextString \"99初名機⼯888株式会社99\") 89

90 ;;;改单⾏⽂字对象的颜⾊

91 (Vlax-Put-Property txtObjName 'Color 42 ) 92

93 ;;;改单⾏⽂字对象的对正⽅式

94 (Vlax-Put-Property txtObjName 'Alignment 4 )

95 ;;;Alignment 对正 justifytext命令对正选项 96 ;;;acAlignmentLeft 0 基线左对齐 L 97 ;;;acAlignmentCenter 1 基线居中 C 98 ;;;acAlignmentRight 2 基线右对齐 R 99 ;;;acAlignmentAligned 3 对齐 A100 ;;;acAlignmentMiddle 4 中间 M101 ;;;acAlignmentFit 5 布满 F102 ;;;acAlignmentTopLeft 6 左上 TL103 ;;;acAlignmentTopCenter 7 中上 TC104 ;;;acAlignmentTopRight 8 右上 TR105 ;;;acAlignmentMiddleLeft 9 左中 ML106 ;;;acAlignmentMiddleCenter 10 正中 MC107 ;;;acAlignmentMiddleRight 11 右中 MR108 ;;;acAlignmentBottomLeft 12 左下 BL109 ;;;acAlignmentBottomCenter 13 中下 BC110 ;;;acAlignmentBottomRight 14 右下 BR

111 ;对齐到 acAlignmentLeft 的⽂字使⽤ InsertionPoint 属性来放置⽂字。

112 ;对齐到 acAlignmentAligned 或 acAlignmentFit 的⽂字同时使⽤ InsertionPoint 以及 TextAlignmentPoint 属性来放置⽂字。113 ;对齐到其它任何位置的⽂字使⽤ TextAlignmentPoint 属性来放置⽂字。114

115 ;;;改单⾏⽂字对象的对齐点

116 (Vlax-Put-Property txtObjName 'TextAlignmentPoint (vlax-3D-point midPt) )117

118 ;;;改单⾏⽂字对象的插⼊点

119 (Vlax-Put-Property (Vlax-Ename->Vla-Object (car (entsel))) 'InsertionPoint (vlax-3D-point pt) )

120

121 ;;;获取圆对象的圆⼼

122 (setq LstCenter (cdr (assoc 10 (entget (car (entsel))))));返回值为⼀个三维圆⼼坐标表

123 (setq variantCenter (Vla-Get-Center circleObj));返回值类型为变体，(vlax-safearray->list (vlax-variant-value (Vla-Get-Center (vlax-ename->vla-object (car (entsel))))))124 (Setq LstCenter (Vlax-Get circleObj 'Center));返回值为⼀个三维圆⼼坐标表125

126 ;;;遍历块定义中每个图元

127 (vlax-for obj (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) \"块名\")128 ...129 )130

131 ;;;遍历当前⽂档块定义的集合，获取每个块定义的名称，并存⼊表blockNameLst中132 (setq blocks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))133 (setq blockNameLst nil)134 (vlax-for block blocks

135 (setq blockName (Vlax-Get block 'Name ))

136 (setq blockNameLst (append blockNameLst (list blockName)))137 )138

139 ;;;当前⽂档中块定义的个数

140 (Vlax-Get (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'Blocks) 'Count )141

142 ;;;第i个块定义对象

143 (Vlax-Invoke-Method (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'Blocks) 'item i)144

145 ;;;第i个块定义对象的名称

146 (Vlax-Get (Vlax-Invoke-Method (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'Blocks) 'item i) 'Name )147 (vla-get-name (Vlax-Invoke-Method (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'Blocks) 'item i))