创建一个新对象或图元,赋给它一个句柄和图元名(但不指定所有者),并返回新图元的名称
(entmakex [elist])
entmakex 函数可以定义图形或非图形图元。
参数
elist
图元定义数据表,其格式与 entget 函数所返回表的格式相似。elist 参数必须包含创建图元的全部必要数据。如果省略了任何一个必须的定义数据,该函数就会返回 nil 并拒绝创建该图元。如果省略了可选的定义数据(如图层),entmakex 使用缺省值。
返回值
如果成功,则 entmakex 返回定义数据的图元表。如果 entmakex 无法创建图元,则返回 nil。
示例
_$ (entmakex '((0 . "CIRCLE") (62 . 1) (10 4.0 3.0 0.0) (40 . 1.0)))
<图元名: 1d45558>
警告! 没有所有者的对象和图元不被写到 .dwg 或 .dxf 文件。请确认在使用 entmakex 后设置所有者。例如,可以使用 dictadd 设置某词典拥有该对象。
参阅
;;167.1 [功能] Entmake直线
(defun EntmakeLine
(p1 p2)
(entmakeX (list '(0 . "LINE") (cons 10 p1) (cons 11
p2)))
)
;;167.2 [功能] Entmake两顶点多段线(多顶点类似)
(defun
entmakeLWPOLYLINE (pt1 pt2)
(entmakeX
(list '(0
. "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 .
"AcDbPolyline")
(cons 90 2)
(cons 10
pt1)
(cons 10 pt2)
)
)
)
;;167.3 [功能] Entmake点表生成多段线
(defun
Make-LWPOLYLINE (lst / PT)
(entmakeX
(append
(list '(0 .
"LWPOLYLINE")
'(100 .
"AcDbEntity")
'(100 .
"AcDbPolyline")
(cons 90 (length
lst))
)
(mapcar '(lambda (pt) (cons 10 pt)) lst)
)
)
)
;;167.4 [功能] Entmake圆
(defun EntmakeCIRCLE
(cen r)
(entmakeX (list '(0 . "CIRCLE") (cons 10 cen) (cons 40
r)))
)
;;167.5 [功能] Entmake圆弧
(defun EntmakeArc
(pt r ang1 ang2)
(entmakeX
(list '(0 .
"ARC")
(cons 10 pt)
(cons 40 r)
(cons 50 ang1)
(cons 51 ang2)
)
)
)
;;167.6 [功能] Entmake单行文本
(defun Make-TEXT
(pt str Textheigh)
(entmakeX
(list '(0 . "TEXT")
(cons 1 str) (cons 10 pt) (cons 40 Textheigh))
)
)
;;167.7 [功能] Entmake居中单行文字
(defun
EntmakeText (PT STR Textheigh)
(entmakeX
(list
'(0 . "TEXT")
(cons 1 str)
(cons 10
pt)
(cons 40 Textheigh)
(cons 11
pt)
(cons 72 1)
(cons 73
2)
)
)
)
;;167.8 [功能] Entmake多行文本
(defun
EntmakeMtext (str pt)
(entmakeX
(list '(0 .
"MTEXT")
'(100 . "AcDbEntity")
'(100 .
"AcDbMText")
;;'(7 . "Standard")
(cons 1
str)
(cons 10 pt)
)
)
)
;;167.9 [功能] Entmake半径标注
;;(EntmakeRadial
(getpoint) (getpoint))
(defun EntmakeRadial (cen p2)
(entmakeX
(list '(0 . "DIMENSION")
'(100 .
"AcDbEntity")
'(100 . "AcDbDimension")
(cons 10
cen)
'(70 . 36)
'(100 .
"AcDbRadialDimension")
(cons 15 p2)
)
)
)
;;167.10 [功能] Entmake直径标注 by自贡黄明儒整理
;;p1
p2圆上点,txtpt文字放置点
;;(setq eD (EntmakeDiametric
(getpoint)(getpoint)(getpoint)))
(defun EntmakeDiametric (p1 p2
txtpt)
(entmakeX
(list '(0 .
"DIMENSION")
'(100 . "AcDbEntity")
'(100 .
"AcDbDimension")
(cons 10 p1)
(cons 11
txtpt)
'(70 . 163)
'(100 .
"AcDbDiametricDimension")
(cons 15 p2)
)
)
)
;;167.11 [功能] Entmake水平标注 by自贡黄明儒整理
;;p1
p2点,txtpt文字放置点
;;(setq eD (EntmakeDimensionH
(getpoint)(getpoint)(getpoint)))
(defun EntmakeDimensionH (p1 p2
txtpt)
(entmakeX
(list '(0 .
"DIMENSION")
'(100 . "AcDbEntity")
'(100 .
"AcDbDimension")
(cons 10 txtpt)
'(70 .
32)
'(1 . "")
'(100 .
"AcDbAlignedDimension")
(cons 13 p1)
(cons 14
p2)
'(100 . "AcDbRotatedDimension")
)
)
)
;;167.12 [功能] Entmake垂直标注 by自贡黄明儒整理
;;p1
p2点,txtpt文字放置点
;;(setq eD (EntmakeDimensionV
(getpoint)(getpoint)(getpoint)))
(defun EntmakeDimensionV (p1 p2
txtpt)
(entmakeX
(list '(0 .
"DIMENSION")
'(100 . "AcDbEntity")
'(100 .
"AcDbDimension")
(cons 10 txtpt)
'(70 .
32)
'(1 . "")
'(100 .
"AcDbAlignedDimension")
(cons 13 p1)
(cons 14
p2)
'(50 . 1.5708)
'(100 .
"AcDbRotatedDimension")
)
)
)
;;167.13 [功能] Entmake倾斜标注 by自贡黄明儒整理
;;p1
p2点,txtpt文字放置点
(defun EntmakeAlignedDim (p1 p2 txtpt)
(entmakeX
(list '(0 . "DIMENSION")
'(100 .
"AcDbEntity")
'(100 . "AcDbDimension")
(cons 10
txtpt)
'(70 . 33)
'(1 . "")
'(100 . "AcDbAlignedDimension")
(cons 13 p1)
(cons 14 p2)
)
)
)
;;167.14 [功能] Entmake生成普通块
by自贡黄明儒整理
;;(EntmakeBlock (ssget) (getpoint) "AA")
(defun EntmakeBlock (ss
pt name / E EN I )
(entmake
(list '(0 . "block")
(cons 2 name) '(70 . 0) (cons 10 pt))
)
(repeat (setq i
(sslength ss))
(setq e (ssname ss (setq i (1-
i))))
(setq en (entget e))
(cond (en
(entmake (cdr en)) (entdel e)))
)
(entmake '((0 .
"ENDBLK")))
(entmake (list '(0 . "INSERT") (cons 2 name) (cons
10 pt)))
)
;;167.15 [功能] Entmake插入块(插入属性块时,属性丢失)
by自贡黄明儒整理
;;(EntmakeInsert "ccd1" (getpoint))
(defun EntmakeInsert(name
pt)
(entmake (list '(0 . "INSERT") (cons 2 name) (cons 10
pt)))
)
;;167.16 [功能] Entmake生成无名块
by自贡黄明儒整理
;;(EntmakeBlockNon (ssget) (getpoint))
(defun EntmakeBlockNon
(ss pt / E EN I NAME)
(entmake (list '(0 . "block") '(2 . "*U") '(70 .
1) (cons 10 pt)))
(repeat (setq i (sslength ss))
(setq e (ssname ss (setq i (1- i))))
(setq en (entget
e))
(cond (en (entmake (cdr en)) (entdel e)))
)
(setq name (entmake '((0 . "ENDBLK"))))
(entmake (list '(0
. "INSERT") (cons 2 name) (cons 10 pt)))
)
;;167.17 [功能]
Entmake将选择集做成属性块(单行文本转为属性)
;;(EntmakeBlockText (ssget) (getpoint)
"B7")
(defun EntmakeBlockText (ss pt name / E EN I)
(entmake
(list '(0 . "block") (cons 2 name) '(70 . 2) (cons 10 pt)))
(repeat
(setq i (sslength ss))
(setq e (ssname ss (setq i (1-
i))))
(setq en (entget e))
(cond
(en
(cond
((equal (cdr (assoc
0 en)) "TEXT")
(entmake
(list '(0 .
"ATTDEF")
(assoc 10 en)
(assoc 40
en)
(assoc 1 en)
(cons 3 (cdr (assoc
1 en)))
(cons 2 (cdr (assoc 1 en)))
'(70 . 0)
)
)
)
(T (entmake (cdr en)))
)
;;(entdel
e)
)
)
)
(entmake '((0 . "ENDBLK")))
)
;;167.18 [功能] Entmake生成图层 by自贡黄明儒整理
;;(setq
layer (EntmakeLayer "MY2"))
(defun EntmakeLayer (LayerName)
(entmakeX
(list '(0 . "LAYER")
'(100 .
"AcDbSymbolTableRecord")
'(100 .
"AcDbLayerTableRecord")
'(70 . 0)
(cons 2 LayerName)
)
)
)
;;167.19 [功能] Entmake创建新线型
;;(setq a
(Entmakelinetype))
(defun Entmakelinetype ()
(entmakeX
(list '(0 . "LTYPE")
'(100 .
"AcDbSymbolTableRecord")
'(100 .
"AcDbLinetypeTableRecord")
(cons 2 "BERDIG
5-545")
'(3 . "Border ____ ____
____ ____ ____")
'(70 .
0)
'(73 . 2)
'(40 . 15.0)
'(49 .
10.0)
'(74 . 0)
'(49 . -5.0)
'(74 . 0)
)
)
)
;;167.20 [功能] Entmake引线
by自贡黄明儒整理
;;Sp起点
;;(setq a (EntmakeLeader
(getpoint)(getpoint)(getpoint)))
(defun EntmakeLeader (Sp pt Ep
Ang)
(entmakeX
(list '(0 .
"LEADER")
'(100 . "AcDbEntity")
'(100 .
"AcDbLeader")
(cons 10 Sp)
(cons 10
pt)
(cons 10 Ep)
)
)
)
(defun EntmakeLeader2 (Sp Ep)
(entmakeX
(list '(0 . "LEADER")
'(100 .
"AcDbEntity")
'(100 . "AcDbLeader")
(cons 10
Sp)
(cons 10 Ep)
)
)
)
;;167.21 [功能] Entmake X轴(Y轴)构造线
by自贡黄明儒整理
;;Flag T时,在X轴线上产生射线
;;示例 (EntmakeXline (getpoint)
T)产生平行X轴的射线
(defun EntmakeXline (pt Flag / P1)
(if
Flag
(setq p1 '(1 0 0))
(setq p1 '(0
1 0))
)
(entmakeX (list '(0 .
"XLINE")
'(100 .
"AcDbEntity")
'(100 .
"AcDbXline")
(cons 10
pt)
(cons 11
p1)
)
)
)
;;167.22 [功能] Entmake椭圆 by自贡黄明儒整理
;;40
短轴/长轴; 10 中点 ;11 相对于中点,长轴上一点
;;(setq a (EntmakeEllipse (getpoint)(getpoint)
0.5))
(defun EntmakeEllipse (p1 p2 num)
(entmakeX
(list '(0 . "ELLIPSE")
'(100 .
"AcDbEntity")
'(100 . "AcDbEllipse")
(cons 10
p1)
(cons 11 (mapcar '- p2 p1))
(cons 40
num)
)
)
)
;;167.23 [功能] Entmake点 by自贡黄明儒整理
(defun
EntmakePoint (Pt)
(entmakeX (list '(0 . "POINT") (cons 10
pt)))
)
;;167.24 [功能] Entmake文字样式
;;h 字高; 41
宽度因子
;;(EntmakeTextStyle "My" 4 2)
(defun EntmakeTextStyle (name h
w)
(entmakeX
(list
'(0 .
"STYLE")
'(100 .
"AcDbSymbolTableRecord")
'(100 .
"AcDbTextStyleTableRecord")
(cons 2
name)
'(70 .
0)
(cons 40
h)
(cons 41
w)
'(3 .
"romans.shx")
'(4 .
"Hztxts.shx")
)
)
)
;;167.25 [功能]
Entmake标注样式
;;(EntmakeDimStyle "my")
(defun EntmakeDimStyle
(name)
(entmakeX
(list
'(0 .
"DIMSTYLE")
'(100 .
"AcDbSymbolTableRecord")
'(100 .
"AcDbDimStyleTableRecord")
'(70 .
0)
(cons 340 (tblobjname "style"
"Standard")) ; 文字样式名
(cons 2 name) ;
标注样式名
'(3 .
"M<>") ;
标注前缀
'(40 .
0.0) ;
标注特征比例,缩放到布局
'(41 .
2.5) ;
箭头尺寸
'(42 .
1.5) ;
起点偏移量
'(43 .
5.5) ;
基线间距
'(44 .
1.5) ;
超出尺寸线
'(47 .
0.000) ;
上偏差
'(48 .
0.000) ;
下偏差
'(71 .
0) ;
公差无
'(77 .
1) ;
文字在尺寸线上方
'(74 .
1)
;
'(140 .
3.0) ;
文字高度
'(141 .
-2.5) ;
圆心标记
'(144 .
1.0) ;
测量比例单位
'(146 .
0.7) ;
公差高度比例
'(147 .
1.0) ;
文字从尺寸线偏移
'(172 .
2) ;
尺寸界线间连线
'(176 .
256) ;
随层
'(177 .
256) ;
随层
'(178 .
256) ;
随层
'(271 .
3) ;
尺寸标注精度
'(272 .
3) ;
公差标注精度
'(275 .
0) ;
角度标注制式,十进制。
'(288 .
1) ;
手动放置尺寸
)
)
)
;;167.26 [功能]
Entmake点表生成样条曲线
;;(EntmakeSpline
(list(getpoint)(getpoint)(getpoint)(getpoint)(getpoint)))
(defun
EntmakeSpline (pts / PT)
(entmakeX
(append
(list '(0 . "SPLINE") '(100 .
"AcDbEntity") '(100 . "AcDbSpline") '(71 . 3))
(mapcar '(lambda (pt) (cons 11 pt)) pts)
)
)
)
;;167.27 [功能]
Entmake封闭3d多段线
;;(Entmake3dPoly
(list(getpoint)(getpoint)(getpoint)(getpoint)(getpoint)))
(defun
Entmake3dPoly (pts / e)
(Entmake (list '(0 . "POLYLINE") '(70 .
9)))
(foreach p Pts
(entmake (list '(0 .
"VERTEX") '(70 . 32) (cons 10 p)))
)
(entmake '((0 .
"SEQEND")))
(entlast)
)
(defun www ()
;;符号表的必要条件
(EntMakeX '((0 . "LAYER")
(100 .
"AcDbSymbolTableRecord")
(100 .
"AcDbLayerTableRecord")
(2 .
"MyLAYER")
(70 .
0)
)
)
(EntMakeX '((0 .
"LTYPE")
(100 .
"AcDbSymbolTableRecord")
(100 .
"AcDbLinetypeTableRecord")
(2 .
"MyLTYPE")
(70 .
0)
)
)
(EntMakeX '((0 .
"VIEW")
(100 .
"AcDbSymbolTableRecord")
(100 .
"AcDbViewTableRecord")
(2 .
"MyVIEW")
(70 .
0)
)
)
(EntMakeX '((0 .
"STYLE")
(100 .
"AcDbSymbolTableRecord")
(100 .
"AcDbTextStyleTableRecord")
(2 .
"MySTYLE")
(70 .
0)
)
)
(EntMakeX '((0 .
"APPID")
(100 .
"AcDbSymbolTableRecord")
(100 .
"AcDbRegAppTableRecord")
(2 .
"MyAPPID")
(70 .
0)
)
)
(EntMakeX '((0 .
"UCS")
(100 .
"AcDbSymbolTableRecord")
(100 .
"AcDbUCSTableRecord")
(2 .
"MyUCS")
(70 .
0)
(11 0.904145 0.427225
0.0)
(12 -0.427225 0.904145
0.0)
)
)
(EntMakeX '((0 .
"DIMSTYLE")
(100 .
"AcDbSymbolTableRecord")
(100 .
"AcDbDimStyleTableRecord")
(2 .
"My")
(70 .
0)
)
)
(EntMakeX '((0 .
"VPORT")
(100 .
"AcDbSymbolTableRecord")
(100 .
"AcDbViewportTableRecord")
(2 .
"My")
(70 .
0)
)
)
)
;;181.3 [功能] 插入块(entmake法
属性或者非属性块)
;;(EntmakeInsertB "ccd1" (getpoint))
;;(EntmakeInsertB "TYBTL"
(getpoint))
(defun EntmakeInsertB (name pt / E EN P10 STR)
(defun
MKATTRIB (pt str H)
(entmake
(list
'(0 .
"ATTRIB")
'(100 .
"AcDbEntity")
'(100 .
"AcDbText")
(cons 10
pt)
(cons 40
H)
(cons 1
str)
'(100 .
"AcDbAttribute")
(cons 2
str)
'(70 .
0)
)
)
)
(setq e (TBLOBJNAME "Block" name))
(setq
pt (trans pt 1 0))
(cond ((equal (assoc 70 (entget e)) '(70 .
0))
(entmake (list '(0 . "INSERT") (cons 2 name) (cons 10
pt)))
)
(T
(entmake (list '(0 . "INSERT") '(66 . 1)
(cons 2 name) (cons 10 pt)))
(while (setq e (entnext
e))
(setq en (entget e))
(cond
((equal (assoc 0 en) '(0 . "ATTDEF"))
(setq p10 (mapcar '+ pt (cdr (assoc 10 en))))
(setq str
(cdr (assoc 1 en)))
(MKATTRIB p10 str
(cdr (assoc 40 en)))
)
)
)
(entmake '((0 . "SEQEND")))
)
)
(entlast)
)
;;[功能] 产生遮罩
;;(MyWipeout (list
(getpoint)(getpoint)(getpoint)(getpoint)))
(defun MyWipeout (lst / A B P X
Y)
(if (not (member "acwipeout.arx"
(arx)))
;确保"acwipeout.arx"加载:
(ARXLOAD "acwipeout.arx")
)
(setq lst (cons (last lst) lst))
(setq p (apply 'mapcar
(cons 'min lst)))
(setq b (apply 'mapcar (cons 'max lst)))
(setq b (apply 'max (mapcar '- b p)))
(setq c (mapcar '+ p (list (* b
0.5) (* b 0.5))))
(entmake
(append
(list '(000 .
"WIPEOUT")
'(100 .
"AcDbEntity")
'(100 .
"AcDbWipeout")
(cons 10 (trans p 1
0))
(cons 11 (trans (list b 0.0) 1
0))
(cons 12 (trans (list 0.0 b) 1
0))
'(280 . 1)
'(071 .
2)
)
(mapcar
'(lambda (a)
(cons 14 (mapcar '(lambda (x
y z) (/ (- x y) z)) a c (list b (- b))))
)
lst
)
)
)
)
明经通道 版权所有 未经许可 不得传播 |
评论 |