licream 发表于 2012-5-25 16:20:26

有没有类拟lsp生成一个边界框


请问下有没有类似lsp可以窗选左边的图生成一个边界矩形框.
谢谢。

296715530 发表于 2019-12-15 13:24:05

本帖最后由 296715530 于 2019-12-15 15:29 编辑

Gu_xl 发表于 2012-5-25 17:49

感谢版主
东拼西凑加了记忆功能，和外框指定图层，以及中途退出捕捉恢复



(defun c:wk (/ ss i l1 l2 ll ur os d)
(defun *MYERR* (MSG)
(setvar "CMDECHO" CMD_OLD)
(setvar "OSMODE" OS_OLD)
(setq *ERROR* *OLDERR*)
(if (= MSG "完美退出。谢谢使用。")
   (princ (strcat "\\n>>>" MSG))
   (princ "\n>>>虽然中途退出了，对象捕捉已经被恢复。")
)
(princ)
    )
    (setq *OLDERR* *ERROR*
   *ERROR**MYERR*
   OS_OLD   (getvar "OSMODE")
   CMD_OLD(getvar "CMDECHO")
    )
(setvar "CMDECHO" 0);_关闭命令提示
(Setq osmode_bak (getvar "osmode"));_记录捕捉
(Setvar "osmode" 0);_关闭捕捉

(if *Scale* (setq d (getreal (strcat"\n偏距<" (rtos *Scale* 2 2) ">:") ) )(setq d (getreal"\n偏

距:")))
(if (null d) (setq d *Scale*) (setq *Scale*d ))

(setq ss (ssget))
(repeat (setq i (sslength ss))
    (vla-getboundingbox
      (vlax-ename->vla-object (ssname ss (setq i (1- i))))
      'll
      'ur
    )
    (setq l1 (cons (vlax-safearray->list ll) l1)
          l2 (cons (vlax-safearray->list ur) l2)
    )
)
(mapcar 'set
          (list 'll 'ur)
          (mapcar '(lambda (a b) (apply 'mapcar (cons a b)))
                  '(min max)
                  (list l1 l2)
          )
)
(command
    "rectang"
    (trans (polar ll (* pi 1.25) (setq d (sqrt (+ (* d d) (* d d)))))
         0
         1
    )
    (trans (polar ur (* pi 0.25) d) 0 1)
)

(command "CHPROP" "L" "" "LA" "_3" "");指定图层
(Setvar "osmode" osmode_bak);_还原捕捉


(setvar "CMDECHO" 1);_打开命令提示


(princ)
)

tangjunasd58 发表于 2019-6-25 00:01:38

;【PF工具箱--自动边界盒】
(defun c:bjh (/ ss i l1 l2 ll ur os d)
   (setq os (getvar 'osmode))
   (PRINC "\n【PF工具箱--QQ交流群：214654218】--自动边界盒 ")(PRINC)
   (setq d (getreal "\n偏距<5>"))
   (if (null d)
   (setq d 5)
   )
   (setq ss (ssget))
   (repeat (setq i (sslength ss))
   (vla-getboundingbox
       (vlax-ename->vla-object (ssname ss (setq i (1- i))))
       'll
       'ur
   )
   (setq l1 (cons (vlax-safearray->list ll) l1)
         l2 (cons (vlax-safearray->list ur) l2)
   )
   )
   (mapcar 'set
         (list 'll 'ur)
         (mapcar '(lambda (a b) (apply 'mapcar (cons a b)))
                   '(min max)
                   (list l1 l2)
         )
   )
   (command
   "rectang"
   (trans (polar ll (* pi 1.25) (setq d (sqrt (+ (* d d) (* d d)))))
            0
            1
   )
   (trans (polar ur (* pi 0.25) d) 0 1)
   )
   (setvar 'osmode os)
   (princ)
)

Gu_xl 发表于 2012-5-25 17:49:58

本帖最后由 Gu_xl 于 2012-5-25 17:50 编辑


(defun c:tt (/ ss i l1 l2 ll ur os d)
(setq os (getvar 'osmode))
(setvar 'osmode 0)
(setq d (getreal "\n偏距<10>"))
(if (null d)
    (setq d 10)
)
(setq ss (ssget))
(repeat (setq i (sslength ss))
    (vla-getboundingbox
      (vlax-ename->vla-object (ssname ss (setq i (1- i))))
      'll
      'ur
    )
    (setq l1 (cons (vlax-safearray->list ll) l1)
          l2 (cons (vlax-safearray->list ur) l2)
    )
)
(mapcar 'set
          (list 'll 'ur)
          (mapcar '(lambda (a b) (apply 'mapcar (cons a b)))
                  '(min max)
                  (list l1 l2)
          )
)
(command
    "rectang"
    (trans (polar ll (* pi 1.25) (setq d (sqrt (+ (* d d) (* d d)))))
         0
         1
    )
    (trans (polar ur (* pi 0.25) d) 0 1)
)
(setvar 'osmode os)
(princ)
)

xyp1964 发表于 2012-5-25 18:07:07


;; 边界外框 伪源码 需要e派工具箱(XCAD)的支持：http://xyp1964.ys168.com
(defun c:tt ()
(if (setq ss (ssget))
    (xyp-rectang
      (xyp-get-Pt2XY (xyp-get-9pt ss 1) -10 -10)
      (xyp-get-Pt2XY (xyp-get-9pt ss 9) 10 10)
    )
)
(princ)
)

qq229918602 发表于 2012-5-25 19:54:51

版主的很好。。

licream 发表于 2012-5-25 21:28:54

非常感谢二位楼版主，这问题终于解决了。谢谢你们。

yoyoho 发表于 2012-5-26 12:10:58

感谢二位楼版主分享程序!

sfzyr 发表于 2012-5-26 16:28:28

版主的 (mapcar 'set
20.          (list 'll 'ur)
21.          (mapcar '(lambda (a b) (apply 'mapcar (cons a b)))
22.                  '(min max)
23.                  (list l1 l2)
24.          )
25.)
mapcar 用的甚是好啊！

zhuquanmao 发表于 2012-10-14 18:32:38

感谢版主分享！

yaokui25 发表于 2012-10-14 22:07:28

这个我一直在找，谢谢

lish 发表于 2012-11-12 14:03:11

学习！！！！！
页: [1] 2 3
查看完整版本: 有没有类拟lsp生成一个边界框