求选择图元可以自动生成图元最大外形的矩形,并且矩形的长宽为整数的lisp程序!

 我来答
朱06CAD
2019-05-27 · 知道合伙人软件行家
朱06CAD
知道合伙人软件行家
采纳数:4172 获赞数:18068
高中,熟悉AutoCAD。会autolisp及VBA程序。

向TA提问 私信TA
展开全部
(defun c:tes ( / &kw ent ss1 sx x1 x2 y1 y2)
 (vl-load-com)
 (princ "\n请选择对象")
 (if (setq &kw (ssget))
  (progn
   (setq ss1 '())
   (while (setq ent (ssname &kw 0))
    (setq &kw (ssdel ent &kw) ss1 (cons ent ss1))
   );while
   (setq ss1 (mapcar 'vlax-ename->vla-object ss1))
   (setq ss1 (apply 'append (mapcar 'x1903211 ss1)))
   (setq sx (vl-sort (mapcar 'car ss1) '<))
   (setq x1 (car sx) x2 (last sx))
   (setq sx (s1905271 x1 x2) x1 (car sx) x2 (cadr sx))
   (setq sx (vl-sort (mapcar 'cadr ss1) '<))
   (setq y1 (car sx) y2 (last sx))
   (setq sx (s1905271 y1 y2) y1 (car sx) y2 (cadr sx))
   (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) '(38 . 0) (cons 10 (list x1 y1)) (cons 10 (list x2 y1)) (cons 10 (list x2 y2)) (cons 10 (list x1 y2))))
  )
 )
 (princ)
)

;长度为小数点后2位
(defun s1905271 (i1 i2 / i i1 i2 i3 i4)
 (setq i3 (* 0.5 (+ i2 i1)) i4 (- i2 i1) i (atof (rtos i4 2 2)))
 (if (> i4 i) (setq i (+ i 0.01)) )
 (setq i (* 0.5 i))
 (list (- i3 i) (+ i3 i))
)
 
(defun x1903211 (obj / obj x y)
 (vla-getboundingbox obj 'x 'y)
 (mapcar 'vlax-safearray->list (list x y));点表
)
更多追问追答
追问
朱老师,是得出来的矩形长宽为整数!麻烦告知,谢谢!
追答
(rtos i4 2 2)里面的2改为0即修改为(rtos i4 2 0)
(setq i (+ i 0.01))里面的0.01修改为1。
推荐律师服务: 若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询

为你推荐:

下载百度知道APP,抢鲜体验
使用百度知道APP,立即抢鲜体验。你的手机镜头里或许有别人想知道的答案。
扫描二维码下载
×

类别

我们会通过消息、邮箱等方式尽快将举报结果通知您。

说明

0/200

提交
取消

辅 助

模 式