明经通道 AutoLISP 函数   
entmakex
 

创建一个新对象或图元,赋给它一个句柄和图元名(但不指定所有者),并返回新图元的名称

(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 设置某词典拥有该对象。

参阅

entmakehandent 函数。

;;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
      )
    )
  )
)

明经通道 版权所有 未经许可 不得传播

 评论