AutoLISP查询图元信息

转载

mb5fe94dcc39b15 2011-04-11 20:56:00

文章标签 AutoLISP 文章分类 代码人生

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