图元加边框 求高手改进一下

吴外安放

只能一个个加边框，不能连续加，而且有时候加有误差，
(defun c:bb ()
  (setvar "cmdecho" 0)
  (setq ss (SSGET))
  (setq p1 (getvar "extmax"))
  (setq p2 (getvar "extmin"))
  (setq aaa (getreal "\n每边加(<30>?):"))
  (if (= aaa nil)
    (setq aaa 30.0)
  )
  (print p1)
  (setq p1 (mapcar '+ p1 (list aaa aaa 0.0)))
  (print p1)
  (setq p2 (mapcar '- p2 (list aaa aaa 0.0)))
  (command "rectangle"  p1 p2)
)
(princ)

Lisphk

你这是给图的EXTMAX和EXTMIN画框，也不是给图元加的啊

huangpc27

你这用的command，肯定受捕捉影响啊，偏差是难免的，又不懂临时关闭捕捉。

yangjian001

做一个热心并受欢迎的人

pxr201419

(defun c:bb  ()
   (setvar "osmode" 0)
   (setq aaa (getdist "\n每边加<30>"))
   (if (= aaa nil)
      (setq aaa 0.0))
   (prompt "\n选择要加框的对象")
   (cond ((setq ss (SSGET ":s"))
          (setq i 0)
          (while (< i (sslength ss))
             (vl-cmdf "_zoom" "o" (ssname ss i) "")
             (setq p1 (mapcar '+ (getvar "extmax") (list aaa aaa 0.0)))
             (setq p2 (mapcar '- (getvar "extmin") (list aaa aaa 0.0)))
             (vl-cmdf "_rectangle" p1 p2)
             (setq i (1+ i)))
          (vl-cmdf "_zoom" "o" ss "")))
   (princ))

extmax extmin是图形范围右上角和左下角的值，以它们画的矩形并不是图元的精确外包盒

吴外安放

pxr201419 发表于 2020-7-30 09:39
(defun c:bb  ()
   (setvar "osmode" 0)
   (setq aaa (getdist "\n每边加"))

好像应该是这样的效果

pxr201419

(defun c:bb  ()
   (setvar "osmode" 0)
   (setq aaa (getdist "\n每边加<30>"))
   (if (= aaa nil)
      (setq aaa 0.0))
   (while (setq e (car(entsel "\n选择要加框的对象")))
      (vl-cmdf "_zoom" "o" e "")
      (setq p1 (mapcar '+ (getvar "extmax") (list aaa aaa 0.0)))
      (setq p2 (mapcar '- (getvar "extmin") (list aaa aaa 0.0)))
      (vl-cmdf "_rectangle" p1 p2)
      (vl-cmdf "_zoom" "p"))
   (princ))

吴外安放

你跟我说 extmax extmin是图形范围右上角和左下角的值，我好像弄错了，不应该是这样，应该要选取图元的大小，而不应该是 extmax extmin对吧，用这个好像都不精确

吴外安放

pxr201419 发表于 2020-8-4 16:34
(defun c:bb  ()
   (setvar "osmode" 0)
   (setq aaa (getdist "\n每边加"))

大哥这样弄出来外包盒比较精准了  但这个只能选 一个对象，不能选多个对象的大外包
(defun c:bb (/ e obj box pts)
  (while (setq e (car (entsel "\n请选取对象: ")))
  (setq obj (vlax-ename->vla-object e))
  (setq box (Getbox obj))
  (setq pts (mapcar '(lambda (p1 p2)
         (getclosestpt obj (getplan p1 p2))
                     ) box (cdr (reverse (cons (car box) (reverse box))))
            )
  )
  (entmakex
    (append '((0 . "LWPOLYLINE")
       (100 . "AcDbEntity")
       (100 . "AcDbPolyline")
       (90 . 4)
       (70 . 1)
      )
     (mapcar
       '(lambda (x) (cons 10 (list (car x) (cadr x))))
       (pnts:box pts)
     )
    )
  )
    )
)

huangpc27

entsel就是选一个对象的，要多个对象的用SSGET