AutoLISP查询图元信息
2011-04-11 20:56 精诚所至 金石为开 阅读(1295) 评论(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))
(strcat "起点:" (rtos (car strpt)) "," (rtos (cadr strpt)))
)
(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,未找到区分椭圆的椭圆弧的方法,查询椭圆弧的信息可参考这里。
![](https://img2024.cnblogs.com/blog/35695/202403/35695-20240328092537879-1189167464.jpg)