kinger 发表于 2022-8-5 11:17:53

自动生成边界线程序的完善

本帖最后由 kinger 于 2022-8-5 11:23 编辑

这个自动加边界线程序是网上下载的，很好用，但是它只能生成一个整体的边界线，高手可以优化一下吗，改为可以批量选择图框块，并给每个图框块生成边界线。
(defun c:bjh (/ ss i l1 l2 ll ur os d)
(setq os (getvar 'osmode))
(PRINC "\n自动边界盒 ")(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)
)

kinger 发表于 2022-8-6 23:57:32

自己顶一下


                                        藏起来的小尾巴,不让你看!

muwind 发表于 2022-8-7 15:26:57

本帖最后由 muwind 于 2022-8-7 15:29 编辑

(defun c:bjTK (/ ss i l1 l2 ll ur os d)
(setq os (getvar 'osmode))
(setq ss (ssget "X" '( (2 . "*图框名*"))))
(setvar 'osmode 0)
(repeat (setq i (sslength ss))
    (vla-getboundingbox
      (vlax-ename->vla-object (ssname ss (setq i (1- i))))
      'll
      'ur
    )
    (setq l1 (vlax-safearray->list ll)
          l2 (vlax-safearray->list ur)
    )
      (command   "rectang"(list (car l1) (cadr l1))(list (car l2) (cadr l2)))
)
(setvar 'osmode os)
(princ)
)

guosheyang 发表于 2022-8-7 17:42:31

       对你的代码做个简单的修改，外面加一层循环对新手来说可执行就行了
;执行(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)
)

hm6313967 发表于 2023-2-23 13:37:16

我看过老外的一个最大边界   可以识别样条曲线 多线段 圆弧 直线块速度快 精度高    可以设置容差！是C#写的   LSP 目前还没有发现有能做到的！ 期待国内大神的杰作！
页: [1]
查看完整版本: 自动生成边界线程序的完善