明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 316|回复: 3

[提问] 自动生成边界线程序的完善

[复制链接]
发表于 2022-8-5 11:17 | 显示全部楼层 |阅读模式
本帖最后由 kinger 于 2022-8-5 11:23 编辑

这个自动加边界线程序是网上下载的,很好用,但是它只能生成一个整体的边界线,高手可以优化一下吗,改为可以批量选择图框块,并给每个图框块生成边界线。
  1. (defun c:bjh (/ ss i l1 l2 ll ur os d)
  2.   (setq os (getvar 'osmode))
  3.   (PRINC "\n自动边界盒 ")(PRINC)  
  4.   (setq d (getreal "\n偏距<5>"))
  5.   (if (null d)
  6.     (setq d 5)
  7.   )
  8.   (setq ss (ssget))
  9.   (repeat (setq i (sslength ss))
  10.     (vla-getboundingbox
  11.       (vlax-ename->vla-object (ssname ss (setq i (1- i))))
  12.       'll
  13.       'ur
  14.     )
  15.     (setq l1 (cons (vlax-safearray->list ll) l1)
  16.           l2 (cons (vlax-safearray->list ur) l2)
  17.     )
  18.   )
  19.   (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.   )
  26.   (command
  27.     "rectang"
  28.     (trans (polar ll (* pi 1.25) (setq d (sqrt (+ (* d d) (* d d)))))
  29.            0
  30.            1
  31.     )
  32.     (trans (polar ur (* pi 0.25) d) 0 1)
  33.   )
  34.   (setvar 'osmode os)
  35.   (princ)
  36. )


 楼主| 发表于 2022-8-6 23:57 | 显示全部楼层
自己顶一下



                                            藏起来的小尾巴,不让你看!  
    发表于 2022-8-7 15:26 | 显示全部楼层
    本帖最后由 muwind 于 2022-8-7 15:29 编辑
    1. (defun c:bjTK (/ ss i l1 l2 ll ur os d)
    2.   (setq os (getvar 'osmode))
    3.   (setq ss (ssget "X" '( (2 . "*图框名*"))))
    4.   (setvar 'osmode 0)
    5.   (repeat (setq i (sslength ss))
    6.     (vla-getboundingbox
    7.       (vlax-ename->vla-object (ssname ss (setq i (1- i))))
    8.       'll
    9.       'ur
    10.     )
    11.     (setq l1 (vlax-safearray->list ll)
    12.           l2 (vlax-safearray->list ur)
    13.     )
    14.         (command   "rectang"  (list (car l1) (cadr l1))  (list (car l2) (cadr l2))  )
    15.   )
    16.   (setvar 'osmode os)
    17.   (princ)
    18. )
    发表于 2022-8-7 17:42 | 显示全部楼层
           对你的代码做个简单的修改,外面加一层循环  对新手来说  可执行就行了
    ;执行(tt(setq s(ssget)))
    (defun tt(s / D I S0)
       (PRINC "\n自动边界盒 ")(PRINC)  
       (setq d (getreal "\n偏距<5>"))
       (if (null d)
        (setq d 5)
       )
       (repeat(setq i(sslength s))
            (ssadd (ssname s (setq i(1- i)))(setq s0(ssadd)))
            (bjh s0 d)
       )
    )
    (defun bjh (ss d / A B I L1 L2 LL OS UR)
      (setq os (getvar 'osmode))
      (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"
        "non"
        (trans (polar ll (* pi 1.25) (setq d (sqrt (+ (* d d) (* d d)))))
               0
               1
        )
         "non"
        (trans (polar ur (* pi 0.25) d) 0 1)
      )
      (setvar 'osmode os)
      (princ)
    )
    您需要登录后才可以回帖 登录 | 注册

    本版积分规则

    小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
    ©2000-2022 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

    GMT+8, 2022-8-8 18:50 , Processed in 0.142797 second(s), 22 queries , Gzip On.

    Powered by Discuz! X3.4

    Copyright © 2001-2021, Tencent Cloud.

    快速回复 返回顶部 返回列表