制造实体类

Free-Lancer · 发表于 2014-8-29 08:07:12

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

来自网络整理, lib.vlx 已包含

(defun Arc:Make (pcen r sp ep)
(entmakex (list '(0 . "ARC")
'(100 . "AcDbEntity")
'(100 . "AcDbArc")
(cons 10 pcen)
(cons 40 r)
(cons 50 (angle pcen sp))
(if (< (angle ep pcen) (angle sp pcen))
(cons 51 (+ pi pi (angle pcen ep)))
(cons 51 (angle pcen ep))
)
)
)
)
(defun Text:Make (p string an height)
(entmakex (list '(0 . "TEXT")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 p)
(cons 1 string)
(cons 40 an)
(cons 50 height)
)
)
)
;;;---------------------------------------------------------------;
;;;功能: 制造点 ;
;;;输入: pts --- 点或点表 ;
;;;输出: 实体或实体表 ;
;;;---------------------------------------------------------------;
(defun Point:Make (pts / mkpt)
(defun mkpt (p)
(entmakex (list '(0 . "POINT")
'(100 . "AcDbEntity")
'(100 . "AcDbPoint")
(cons 10 p)
)
)
)
(if (listp (car pts))
(mapcar '(lambda (x)
(mkpt x)
)
pts
)
(mkpt pts)
)
)
;;;---------------------------------------------------------------;
;;;功能: 制造圆 ;
;;;输入: pts --- 点或点表 radius --- 半径 ;
;;;输出: 实体或实体表 ;
;;;---------------------------------------------------------------;
(defun Circle:Make (pts radius / mkcircle)
(defun mkcircle (p)
(entmakex (list '(0 . "Circle")
'(100 . "AcDbEntity")
'(100 . "AcDbCircle")
(cons 10 p)
(cons 40 radius)
)
)
)
(if (listp (car pts))
(mapcar '(lambda (x) (mkcircle x)) pts)
(mkcircle pts)
)
)
;;;---------------------------------------------------------------;
;;;功能: 制造线 ;
;;;输入: pts --- 点表 ;
;;;输出: 实体或实体表 ;
;;;---------------------------------------------------------------;
(defun Line:Make (pts)
(mapcar '(lambda (x y)
(entmakex (list '(0 . "LINE")
'(100 . "AcDbEntity")
'(100 . "AcDbLine")
(cons 10 x)
(cons 11 y)
)
)
)
pts
(cdr pts)
)
)
;;;---------------------------------------------------------------;
;;;功能: 制造多段线 ;
;;;输入: pts --- 点表(2D) ;
;;;输出: 实体 ;
;;;---------------------------------------------------------------;
(defun Pline:Make (pts tf)
(entmakex (append '((0 . "LWPOLYLINE")
(100 . "AcDbEntity")
(100 . "AcDbPolyline")
)
(list (cons 90 (length pts))
(cons 70
(if tf
1
0
)
)
)
(mapcar '(lambda (x)
(list 10 (car x) (cadr x))
)
pts
)
)
)
)
;;;---------------------------------------------------------------;
;;;功能: 制造圆环 ;
;;;输入: pts --- 点或点表 r1 -- 内径 r2 --- 外径 ;
;;;输出: 实体 ;
;;;---------------------------------------------------------------;
(defun Dount:Make (pts r1 r2 / mkdout)
(defun mkdout (p r1 p2 / d sp ep)
(setq d (* (+ (abs r1) (abs r2)) 0.5)
sp (polar p 0. d)
ep (polar p pi d)
)
(entmakex (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(90 . 2)
'(70 . 1)
(cons 43 (abs (- r2 r1)))
(cons 10 (list (car sp) (cadr sp)))
'(42 . 1.0)
(cons 10 (list (car ep) (cadr ep)))
'(42 . 1.0)
)
)
)
(if (listp (car pts))
(mapcar '(lambda (x) (mkdout x r1 r2)) pts)
(mkdout pts r1 r2)
)
)
;;;---------------------------------------------------------------;
;;;功能: 制造构造线 ;
;;;输入: 点1 点2 ;
;;;输出: 实体 ;
;;;---------------------------------------------------------------;
(defun Xline:Make (p1 p2)
(entmakex (list '(0 . "XLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbXline")
(cons 10 p1)
(cons 11 (polar p1 (angle p1 p2) 1.))
)
)
)
;;;---------------------------------------------------------------;
;;;功能: 制造射线 ;
;;;输入: 点1 点2 ;
;;;输出: 实体 ;
;;;---------------------------------------------------------------;
(defun Ray:Make (p1 p2)
(entmakex (list '(0 . "Ray")
'(100 . "AcDbEntity")
'(100 . "AcDbRay")
(cons 10 p1)
(cons 11 (polar p1 (angle p1 p2) 1.))
)
)
)
(defun Solid:Make (p1 p2 p3 p4)
(entmakex (list '(0 . "Solid")
'(100 . "AcDbEntity")
'(100 . "AcDbSolid")
(cons 10 p1)
(cons 11 p2)
(cons 12 p3)
(cons 13 p4)
)
)
)
(defun Trace:Make (p1 p2 p3 p4)
(entmakex (list '(0 . "TRACE")
'(100 . "AcDbEntity")
'(100 . "AcDbTrace")
(cons 10 p1)
(cons 11 p2)
(cons 12 p3)
(cons 13 p4)
)
)
)
;|
(defun Ellipse:Make (p p1 p2)
(entmakex
(list
'(0 . "ELLIPSE")
'(100 . "AcDbEnity")
'(100 . "AcDbEllipse")
(cons 10 p)
(cons 11 (mapcar '- p1 p))
(cons 40 (/ (distance p p1) (distance p p2)))
'(41 . 0.)
(cons 42 (+ pi pi))
)
)
)
|;
(defun Insert:Make (bn p scl an)
(entmakex (list '(0 . "INSERT")
'(100 . "AcDbEntity")
'(100 . "AcDbBlockReference")
(cons 2 bn)
(cons 10 p)
(cons 41 scl)
(cons 42 scl)
(cons 43 scl)
(cons 50 an)
)
)
)
;;d70 线性32 对齐33; p3基点 p1第一点 p1第二点
(defun Dim:MakeRotate (p1 p2 p3)
(entmakex (list '(0 . "DIMENSION")
'(100 . "AcDbEntity")
'(100 . "AcDbDimension")
(cons 10 p3)
'(11 0. 0. 0.)
'(70 . 32)
'(100 . "AcDbAlignedDimension")
(cons 13 p1)
(cons 14 p2)
(cons 50 (angle p1 p2))
'(100 . "AcDbRotatedDimension")
)
)
)
;;;---------------------------------------------------------------;
;;;功能: 制造组 ;
;;;输入: ss --- 选择集或实体表 ;
;;;输出: 实体 ;
;;;---------------------------------------------------------------;
(defun Group:Make (ss name / el)
(cond
((eq (type ss) 'PICKSET)
(setq el (ss->objs ss))
)
((= (type (car ss)) 'ENAME)
(setq el (mapcar 'vlax-ename->vla-object el))
)
(t ss)
)
(if (setq grp (vla-add (fy:acgroups)
(if Name
name
"*"
)
)
)
(vla-appenditems
grp
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbobject
(cons 0 (1- (length el)))
)
el
)
)
)
)
grp
)

(defun Arc:Make        (pcen r sp ep) 
  (entmakex (list '(0 . "ARC") 
                  '(100 . "AcDbEntity") 
                  '(100 . "AcDbArc") 
                  (cons 10 pcen) 
                  (cons 40 r) 
                  (cons 50 (angle pcen sp)) 
                  (if (< (angle ep pcen) (angle sp pcen)) 
                    (cons 51 (+ pi pi (angle pcen ep))) 
                    (cons 51 (angle pcen ep)) 
                  ) 
            ) 
  ) 
) 
(defun Text:Make (p string an height) 
  (entmakex (list '(0 . "TEXT") 
                  '(100 . "AcDbEntity") 
                  '(100 . "AcDbText") 
                  (cons 10 p) 
                  (cons 1 string) 
                  (cons 40 an) 
                  (cons 50 height) 
            ) 
  ) 
) 
;;;---------------------------------------------------------------; 
;;;功能: 制造点                                                   ; 
;;;输入: pts --- 点或点表                                         ; 
;;;输出: 实体或实体表                                             ; 
;;;---------------------------------------------------------------; 
(defun Point:Make (pts / mkpt) 
  (defun mkpt (p) 
    (entmakex (list '(0 . "POINT") 
                    '(100 . "AcDbEntity") 
                    '(100 . "AcDbPoint") 
                    (cons 10 p) 
              ) 
    ) 
  ) 
  (if (listp (car pts)) 
    (mapcar '(lambda (x) 
               (mkpt x) 
             ) 
            pts 
    ) 
    (mkpt pts) 
  ) 
) 
;;;---------------------------------------------------------------; 
;;;功能: 制造圆                                                   ; 
;;;输入: pts --- 点或点表 radius --- 半径                         ; 
;;;输出: 实体或实体表                                             ; 
;;;---------------------------------------------------------------; 
(defun Circle:Make (pts radius / mkcircle) 
  (defun mkcircle (p) 
    (entmakex (list '(0 . "Circle") 
                    '(100 . "AcDbEntity") 
                    '(100 . "AcDbCircle") 
                    (cons 10 p) 
                    (cons 40 radius) 
              ) 
    ) 
  ) 
  (if (listp (car pts)) 
    (mapcar '(lambda (x) (mkcircle x)) pts) 
    (mkcircle pts) 
  ) 
) 
;;;---------------------------------------------------------------; 
;;;功能: 制造线                                                   ; 
;;;输入: pts --- 点表                                             ; 
;;;输出: 实体或实体表                                             ; 
;;;---------------------------------------------------------------; 
(defun Line:Make (pts) 
  (mapcar '(lambda (x y) 
             (entmakex (list '(0 . "LINE") 
                             '(100 . "AcDbEntity") 
                             '(100 . "AcDbLine") 
                             (cons 10 x) 
                             (cons 11 y) 
                       ) 
             ) 
           ) 
          pts 
          (cdr pts) 
  ) 
) 
;;;---------------------------------------------------------------; 
;;;功能: 制造多段线                                               ; 
;;;输入: pts --- 点表(2D)                                         ; 
;;;输出: 实体                                                     ; 
;;;---------------------------------------------------------------; 
(defun Pline:Make (pts tf) 
  (entmakex (append '((0 . "LWPOLYLINE") 
                      (100 . "AcDbEntity") 
                      (100 . "AcDbPolyline") 
                     ) 
                    (list (cons 90 (length pts)) 
                          (cons        70 
                                (if tf 
                                  1 
                                  0 
                                ) 
                          ) 
                    ) 
                    (mapcar '(lambda (x) 
                               (list 10 (car x) (cadr x)) 
                             ) 
                            pts 
                    ) 
            ) 
  ) 
) 
;;;---------------------------------------------------------------; 
;;;功能: 制造圆环                                                 ; 
;;;输入: pts --- 点或点表 r1 -- 内径  r2 --- 外径                 ; 
;;;输出: 实体                                                     ; 
;;;---------------------------------------------------------------; 
(defun Dount:Make (pts r1 r2 / mkdout) 
  (defun mkdout        (p r1 p2 / d sp ep) 
    (setq d  (* (+ (abs r1) (abs r2)) 0.5) 
          sp (polar p 0. d) 
          ep (polar p pi d) 
    ) 
    (entmakex (list '(0 . "LWPOLYLINE") 
                    '(100 . "AcDbEntity") 
                    '(100 . "AcDbPolyline") 
                    '(90 . 2) 
                    '(70 . 1) 
                    (cons 43 (abs (- r2 r1))) 
                    (cons 10 (list (car sp) (cadr sp))) 
                    '(42 . 1.0) 
                    (cons 10 (list (car ep) (cadr ep))) 
                    '(42 . 1.0) 
              ) 
    ) 
  ) 
  (if (listp (car pts)) 
    (mapcar '(lambda (x) (mkdout x r1 r2)) pts) 
    (mkdout pts r1 r2) 
  ) 
) 
;;;---------------------------------------------------------------; 
;;;功能: 制造构造线                                               ; 
;;;输入: 点1 点2                                                  ; 
;;;输出: 实体                                                     ; 
;;;---------------------------------------------------------------; 
(defun Xline:Make (p1 p2) 
  (entmakex (list '(0 . "XLINE") 
                  '(100 . "AcDbEntity") 
                  '(100 . "AcDbXline") 
                  (cons 10 p1) 
                  (cons 11 (polar p1 (angle p1 p2) 1.)) 
            ) 
  ) 
) 
;;;---------------------------------------------------------------; 
;;;功能: 制造射线                                                 ; 
;;;输入: 点1 点2                                                  ; 
;;;输出: 实体                                                     ; 
;;;---------------------------------------------------------------; 
(defun Ray:Make        (p1 p2) 
  (entmakex (list '(0 . "Ray") 
                  '(100 . "AcDbEntity") 
                  '(100 . "AcDbRay") 
                  (cons 10 p1) 
                  (cons 11 (polar p1 (angle p1 p2) 1.)) 
            ) 
  ) 
) 
(defun Solid:Make (p1 p2 p3 p4) 
  (entmakex (list '(0 . "Solid") 
                  '(100 . "AcDbEntity") 
                  '(100 . "AcDbSolid") 
                  (cons 10 p1) 
                  (cons 11 p2) 
                  (cons 12 p3) 
                  (cons 13 p4) 
            ) 
  ) 
) 
(defun Trace:Make (p1 p2 p3 p4) 
  (entmakex (list '(0 . "TRACE") 
                  '(100 . "AcDbEntity") 
                  '(100 . "AcDbTrace") 
                  (cons 10 p1) 
                  (cons 11 p2) 
                  (cons 12 p3) 
                  (cons 13 p4) 
            ) 
  ) 
) 
;| 
(defun Ellipse:Make (p p1 p2) 
  (entmakex 
    (list 
      '(0 . "ELLIPSE") 
      '(100 . "AcDbEnity") 
      '(100 . "AcDbEllipse") 
      (cons 10 p) 
      (cons 11 (mapcar '- p1 p)) 
      (cons 40 (/ (distance p p1) (distance p p2))) 
      '(41 . 0.) 
      (cons 42 (+ pi pi)) 
    ) 
  ) 
) 
|; 
(defun Insert:Make (bn p scl an) 
  (entmakex (list '(0 . "INSERT") 
                  '(100 . "AcDbEntity") 
                  '(100 . "AcDbBlockReference") 
                  (cons 2 bn) 
                  (cons 10 p) 
                  (cons 41 scl) 
                  (cons 42 scl) 
                  (cons 43 scl) 
                  (cons 50 an) 
            ) 
  ) 
) 
;;d70 线性32 对齐33; p3基点 p1第一点 p1第二点 
(defun Dim:MakeRotate (p1 p2 p3) 
  (entmakex (list '(0 . "DIMENSION") 
                  '(100 . "AcDbEntity") 
                  '(100 . "AcDbDimension") 
                  (cons 10 p3) 
                  '(11 0. 0. 0.) 
                  '(70 . 32) 
                  '(100 . "AcDbAlignedDimension") 
                  (cons 13 p1) 
                  (cons 14 p2) 
                  (cons 50 (angle p1 p2)) 
                  '(100 . "AcDbRotatedDimension") 
            ) 
  ) 
) 
 
;;;---------------------------------------------------------------; 
;;;功能: 制造组                                                   ; 
;;;输入: ss --- 选择集或实体表                                    ; 
;;;输出: 实体                                                     ; 
;;;---------------------------------------------------------------; 
(defun Group:Make (ss name / el) 
  (cond 
    ((eq (type ss) 'PICKSET) 
     (setq el (ss->objs ss)) 
    ) 
    ((= (type (car ss)) 'ENAME) 
     (setq el (mapcar 'vlax-ename->vla-object el)) 
    ) 
    (t ss) 
  ) 
  (if (setq grp        (vla-add (fy:acgroups) 
                         (if Name 
                           name 
                           "*" 
                         ) 
                ) 
      ) 
    (vla-appenditems 
      grp 
      (vlax-make-variant 
        (vlax-safearray-fill 
          (vlax-make-safearray 
            vlax-vbobject 
            (cons 0 (1- (length el))) 
          ) 
          el 
        ) 
      ) 
    ) 
  ) 
  grp 
)

HLCAD · 发表于 2014-8-29 14:50:18

非常感谢！

aihuyujian · 发表于 2014-9-13 11:41:38

支持一下嘿嘿

账号		自动登录	找回密码
密码			立即注册

[他山之石] 制造实体类

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分