代码改变世界

AutoLISP查询图元信息

2011-04-11 20:56  精诚所至 金石为开  阅读(1316)  评论(0编辑  收藏  举报

AutoLISP查询图元信息,可以查询直线、圆弧、圆、椭圆的相关信息,代码如下。

(defun c:getppt    ()
    (setq ss (car (entsel "请选择要查询的图元:")))
    (setq ssob (vlax-ename->vla-object ss))
    (setq typ
         (cdr
         (assoc
             0
             (entget ss)
         )
         )
    )
    (cond
    ((= "LINE" typ)
     (c:lppt)
    )
    ((= "ARC" typ)
     (c:arcppt)
    )
    ((= "CIRCLE" typ)
     (c:ccleppt)
    )
    ((= "ELLIPSE" typ)
     (c:elppt)
    )
    (print typ)
    )
)
;;;LINE函数
(defun c:lppt ()
;;;    (setq ss (car (entsel "\n请选择所要查询的直线:")))
    (Setq len (Vlax-Get ssob 'Length))
    (Setq ang (Vlax-Get ssob 'Angle))
    (Setq strpt (Vlax-Get ssob 'StartPoint))
    (Setq endpt (Vlax-Get ssob 'EndPoint))
    (print
    (strcat "起点:" (rtos (car strpt)) "," (rtos (cadr strpt)))
    )
    (print
    (strcat "终点:" (rtos (car endpt)) "," (rtos (cadr endpt)))
    )
    (print (strcat "长度:" (rtos len)))
    (print (strcat "角度:" (rtos ang)))
    (princ)
)
;;;圆弧信息
(defun c:arcppt    ()
;;;    (setq ss (car (entsel "\n请选择所要查询的圆弧:")))
;;;    (setq ssob (vlax-ename->vla-object ss))
    (Setq center (Vlax-Get ssob 'center))
    (setq radius (vlax-get ssob 'radius))
    (Setq len (Vlax-Get ssob 'ArcLength))
    (Setq area (Vlax-Get ssob 'area))
    (print (strcat "圆心:"
           (rtos (car center))
           ","
           (rtos (cadr center))
       )
    )
    (print (strcat "半径:" (rtos radius)))
    (print (strcat "长度:" (rtos len)))
    (print (strcat "面积:" (rtos area)))
    (princ)
)
;;;圆信息
(defun c:ccleppt ()
;;;    (setq ss (car (entsel "\n请选择要查询的圆:")))
;;;    (setq ssob (vlax-ename->vla-object ss))
    (setq center (vlax-get ssob 'center))
    (setq radius (vlax-get ssob 'radius))
    (setq area (vlax-get ssob 'area))
    (print (strcat "圆心:"
           (rtos (car center))
           ","
           (rtos (cadr center))
       )
    )
;;;    (print (cons (car center) (cadr center)))
    (print (strcat "半径:" (rtos radius)))
    (print (strcat "周长:" (rtos (* pi (* 2 radius)))))
    (print (strcat "面积:" (rtos area)))
    (princ)
)
;;;椭圆信息
(defun c:elppt ()
;;;    (setq ss (car (entsel "\n请选择所要查询的椭圆:")))
;;;    (setq ssob (vlax-ename->vla-object ss))
    (setq center (vlax-get ssob 'Center))
    (setq maxr (vlax-get ssob 'MajorRadius))
    (setq minr (vlax-get ssob 'MinorRadius))
    (setq area (vlax-get ssob 'Area))
;;;显示信息
    (print (strcat "中心:"
           (rtos (car center))
           ","
           (rtos (cadr center))
       )
    )
    (print (strcat "长轴:" (rtos maxr)))
    (print (strcat "短轴:" (rtos minr)))
    (print (strcat "周长:"
           (rtos (+ (* 2 pi minr) (* 4 (- maxr minr))))
       )
    )
    (print (strcat "面积:" (rtos area)))
    (princ)
)

代码完。

因为椭圆和椭圆弧都是ELLIPSE,未找到区分椭圆的椭圆弧的方法,查询椭圆弧的信息可参考这里