找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 515|回复: 3

[编程申请] 如何获取3维多段线 平面截线 任意轴的最大 边界,都不共面的,截取出来的

[复制链接]

已领礼包: 50个

财富等级: 招财进宝

发表于 2018-6-5 14:39:13 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×
如何获取3维多段线  平面截线 任意轴的最大  边界,都不共面的,最好不要改变原图
请点击此处下载

查看状态:需购买或无权限

您的用户组是:游客

文件名称:获取最大边界线.zip 
下载次数:3  文件大小:116.42 KB 
下载权限: 不限 以上  [免费赚D豆]

,截取出来的,归零用 Unnamed QQ Screenshot20180605143511.png

找不到源码的帖子了,把源码贴出来,希望能改改

;;gxl-GetSSRealBox 获得组合图形最大边界 By Gu_xl 2013.05.19修改
(defun c:tt (/ ss pl)
(vl-load-com)  (while (setq ss (ssget))
    (gxl-GetSSRealBox ss)
  )
  (princ)
)
;;计算盒子 参数 ss 选择集
(defun gxl-GetSSRealBox (ss /           CMDECHO     OSMODE                    N     LL    UR
             PL           BOX         H     PL1   PL2   PT         PTS   PPL1  PPL2
             E           EL         ANG   ENDENT           SS1         ENT   *error*
            )
  (defun *error* (s)
    (command "_undo" "_e")
    (command "u")
    (setvar 'cmdecho 0)
    (setvar 'osmode 0)
    (princ s)
  )
  (setq        cmdecho        (getvar 'cmdecho)
        osmode        (getvar 'osmode)
  )
  (setvar 'cmdecho 0)
  (setvar 'osmode 0)
  (gxl-SYS-STORESVIEWSIZE)
  (command "_undo" "_be")
  (repeat (setq n (sslength ss))
    (setq box (gxl-GETBOXUCS (ssname ss (setq n (1- n))))) ;_ ucs盒子坐标 (list ll ul ur lr)
    (setq pl (append pl box))
  )
  (setq pl (mapcar '(lambda (x) (trans x 0 1)) pl)) ;_ 转到UCS坐标
  (setq        box (list (apply 'mapcar (cons 'min pl))
                  (apply 'mapcar (cons 'max pl))
            )
        h   (* 0.2 (apply 'max (mapcar '- (cadr box) (car box))))
  )
  (setq        pl1
            (vl-sort
              pl
              '(lambda (a b)
                 (if (equal (car a) (car b) 1e-3)
                   (< (cadr a) (cadr b))
                   (< (car a) (car b))
                 )
               )
            ) ;_ 点表按X自小到大排序
        pl2
            (vl-sort
              pl
              '(lambda (a b)
                 (if (equal (cadr a) (cadr b) 1e-3)
                   (< (car a) (car b))
                   (< (cadr a) (cadr b))
                 )
               )
            ) ;_ 点表按Y自小到大排序
  )
  (while pl1
    (setq pt  (car pl1)
          pl1 (cdr pl1)
    )
    (if        (and pl1
             (equal (car pt) (caar pl1) 1e-3)
        )
      (setq pts (cons pt pts))
      (progn
        (setq pts (cons pt pts))
        (setq ppl1 (cons (reverse pts) ppl1)
              pts  nil
        )
      )
    )
  )
  (setq        ppl1 (mapcar '(lambda (x) (list (car x) (last x)))
                     (reverse ppl1)
             )
        pts  nil
  )
  (while pl2
    (setq pt  (car pl2)
          pl2 (cdr pl2)
    )
    (if        (and pl2
             (equal (cadr pt) (cadar pl2) 1e-3)
        )
      (setq pts (cons pt pts))
      (progn
        (setq pts (cons pt pts))
        (setq ppl2 (cons (reverse pts) ppl2)
              pts  nil
        )
      )
    )
  )
  (setq        ppl2 (mapcar '(lambda (x) (list (car x) (last x)))
                     (reverse ppl2)
             )
  )
  (setq ss (ssadd))
  (foreach a ppl1
    (entmake
      (list
        '(0 . "line")
        (cons 10 (trans (car a) 1 0))
        (cons 11 (trans (last a) 1 0))
        (cons 62 1)
      )
    )
    (ssadd (entlast) ss)
  )
  (setq ss1 (ssadd))
  (foreach a ppl2
    (entmake
      (list
        '(0 . "line")
        (cons 10 (trans (car a) 1 0))
        (cons 11 (trans (last a) 1 0))
        (cons 62 1)
      )
    )
    (ssadd (entlast) ss)
  )
  (command "_extend" ss "" "e" "n" "p" "u")
  (repeat (setq n (sslength ss))
    (setq e (ssname ss (setq n (1- n))))
    (command (list e (trans (cdr (assoc 10 (setq el (entget e)))) 0 1)))
    (command (list e (trans (cdr (assoc 11 el)) 0 1)))
    (entupd e)
  )
  (command "")
  (command "_extend" ss "" "e" "n" "p" "u")
  (repeat (setq n (sslength ss))
    (setq e (ssname ss (setq n (1- n))))
    (command (list e (trans (cdr (assoc 10 (setq el (entget e)))) 0 1)))
    (command (list e (trans (cdr (assoc 11 el)) 0 1)))
    (entupd e)
  )
  (command "")
  (command "_rectang"
           "_non"
           (setq
             p1        (polar (car box) (setq ang (apply 'angle box)) (- h))
           )
           "_non"
           (setq p2 (polar (cadr box) ang h))
  )
  (command "_zoom" "w" p1 p2 "_zoom" "0.95x")
  (ssadd (setq endent (entlast)) ss)
  (setq pt (polar (cadr box) ang (* 0.5 h)))
  (command "boundary" "a" "b" "n" ss "" "I" "y" "" pt)
  (while (= 1 (logand (getvar 'cmdactive) 1))
    (command "")
  )
  (setq ss1 (gxl-LST-ENTNEXTALL endent))
  (setq        ss1 (vl-sort ss1
                     '(lambda (a b)
                        (> (vla-get-area (vlax-ename->vla-object a))
                           (vla-get-area (vlax-ename->vla-object b))
                        )
                      )
            )
  )
  (setq ent (cadr ss1))
  (mapcar 'entdel ss1)
  (entdel ent)
  (entmod
    (subst (cons 62 1) (assoc 62 (setq el (entget ent))) el)
  )
  (command "_erase" ss "")
  (command "_undo" "_e")
  (setvar 'cmdecho 0)
  (setvar 'osmode 0)
  (gxl-SYS-RESTORESVIEWSIZE)
  ent
)

;;;返回en后全部图元列表,无则返回 nil,en为nil返回图形全部图元
(defun gxl-lst-EntNextAll (EN / LST)
  (if (not en)
    (progn
    (setq en (entnext))
    (if en (setq lst (list en)))
    )
    )
  (if EN
    (while (setq EN (entnext EN))
      (if (not (member (cdr (assoc 0 (entget EN)))
                       '("ATTRIB" "VERTEX" "SEQEND")
               )
          )
        (setq LST (cons EN LST))
      )
    )
  )
  (reverse LST)
)
;;计算物体包围盒
(defun gxl-getbox (E1 / OBJ MINPOINT MAXPOINT P1 P2 P3 P4 D DD PL D1 D3 D2 D4)
  (if (= 'ENAME (type e1))
  (setq obj (vlax-ename->vla-object e1)) ;转换图元名
    (setq obj e1)
    )
  (if (not
        (VL-CATCH-ALL-ERROR-P
          (VL-CATCH-ALL-APPLY
            'vla-GetBoundingBox
            (list obj 'minpoint 'maxpoint)
          )
        )
      )
    (progn
                                        ;取得包容图元的最大点和最小点
      (setq minpoint (vlax-safearray->list minpoint))
                                        ;把变体数据转化为表
      (setq maxpoint (vlax-safearray->list maxpoint))
                                        ;把变体数据转化为表
      ;;(command "box" minpoint maxpoint 2)

      (if (= (vla-get-objectname obj) "AcDbSpline")
        (progn
          (setq        p1 minpoint
                p2 (list (car minpoint) (cadr maxpoint) (caddr minpoint))
                p3 maxpoint
                p4 (list (car maxpoint) (cadr minpoint) (caddr minpoint))
          )
          (setq        d  (/ (distance p1 p2) 250)
                dd (- d)
                pl nil
          )
          (repeat 251
            (setq pl (cons (polar p1 (* pi 0.5) (setq dd (+ dd d))) pl))
          )
          (setq        d1
                 (car (vl-sort
                        (mapcar
                          '(lambda (x)
                             (distance x
                                       (vlax-curve-getclosestpointto obj x)
                             )
                           )
                          pl
                        )
                        '(lambda (a b) (< a b))
                      )
                 )
          )
          (setq        dd (- d)
                pl nil
          )
          (repeat 251
            (setq pl (cons (polar p4 (* pi 0.5) (setq dd (+ dd d))) pl))
          )
          (setq        d3
                 (car (vl-sort
                        (mapcar
                          '(lambda (x)
                             (distance x
                                       (vlax-curve-getclosestpointto obj x)
                             )
                           )
                          pl
                        )
                        '(lambda (a b) (< a b))
                      )
                 )
          )
          (setq        d  (/ (distance p2 p3) 250)
                dd (- d)
                pl nil
          )
          (repeat 251
            (setq pl (cons (polar p2 0 (setq dd (+ dd d))) pl))
          )
          (setq        d2
                 (car (vl-sort
                        (mapcar
                          '(lambda (x)
                             (distance x
                                       (vlax-curve-getclosestpointto obj x)
                             )
                           )
                          pl
                        )
                        '(lambda (a b) (< a b))
                      )
                 )
          )
          (setq        dd (- d)
                pl nil
          )
          (repeat 251
            (setq pl (cons (polar p1 0 (setq dd (+ dd d))) pl))
          )
          (setq        d4
                 (car (vl-sort
                        (mapcar
                          '(lambda (x)
                             (distance x
                                       (vlax-curve-getclosestpointto obj x)
                             )
                           )
                          pl
                        )
                        '(lambda (a b) (< a b))
                      )
                 )
          )
          (list        (list (+ (car minpoint) d1)
                      (+ (cadr minpoint) d4)
                      (caddr minpoint)
                )
                (list (- (car maxpoint) d3)
                      (- (cadr maxpoint) d2)
                      (caddr minpoint)
                )
          )
        )
        (list minpoint maxpoint)
      )
    )
    (list (getvar 'extmin) (getvar 'extmax))
  )
)
;;(gxl-getboxucs obj) 计算对象的UCS方向包围盒四角点坐标
;;(gxl-AX:AddLwPolyLine *MODEL-SPACE* (gxl-getboxucs (car(entsel))))
(defun gxl-getboxucs (OBJ / MAT MAT1 ORG LL UR UL LR xdir cp ang)
  (if (= 'ENAME (type obj))
    (setq obj (vlax-ename->vla-object obj)) ;转换图元名
  )
  (setq xdir (getvar 'ucsxdir)
        org  (getvar 'ucsorg)
        )
  ;;转换到 平行 WCS
  (vla-rotate obj (setq cp (vlax-3d-point '(0 0 0))) (- (setq ang (atan (cadr xdir) (car xdir)))))
  ;(vla-TransformBy obj (vlax-tmatrix mat)) ;_ 转换到 WCS
  ;(vla-GetBoundingBox obj 'll 'ur) ;_ 计算包围盒
  (mapcar 'set '(ll ur) (gxl-GETBOX obj))
  ;;;_ 还原对象位置
  (vla-rotate obj cp ang)
  ;(vla-TransformBy obj (vlax-tmatrix mat1)) ;_ 还原对象位置
  (setq        ul (list (car ll) (cadr ur) (caddr ll)) ;_ 左上角点
        lr (list (car ur) (cadr ll) (caddr ll)) ;_ 右下角点
  )
  ;;返回UCS方向的WCS坐标
  (mapcar '(lambda (x) (mapcar '- (trans x 1 0) org))
          (list ll ul ur lr)
  )
)

;(gxl-Sys-GetViewSize)
(defun gxl-Sys-GetViewSize (/ pc vh sc vw vh pmin pmax)
  (setq pc (getvar "viewctr")
                 vh (getvar "viewsize")
                 sc (getvar "screensize")
                vw (* vh (/ (car sc) (cadr sc)))
                pmin (list (- (car pc) (* 0.5 vw)) (- (cadr pc) (* 0.5 vh)))
                pmax (list (+ (car pc) (* 0.5 vw)) (+ (cadr pc) (* 0.5 vh)))
           )
  (list pmin pmax)
  )

;;;储存屏幕尺寸 gxl-Sys-StoresViewSize
(defun gxl-Sys-StoresViewSize (/ pc vh sc vw pmin pmax)  
  (setq *ViewSize* (gxl-Sys-GetViewSize))
  )
;;;恢复屏幕尺寸 gxl-Sys-RestoresViewSize
(defun gxl-Sys-RestoresViewSize ()
  (if *ViewSize*
    (progn
      (command "_.Zoom" "W" (car *ViewSize*) (cadr *ViewSize*))
      (setq *ViewSize* nil)
      )
    )
  )

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

已领礼包: 50个

财富等级: 招财进宝

 楼主| 发表于 2018-6-5 14:44:11 | 显示全部楼层
本帖最后由 君是我的泪 于 2018-6-5 14:45 编辑

代码有点长,难度有点大,原先代码只针对xy标准轴的,锯齿状的,只能原作者改一下了 Unnamed QQ Screenshot20180605144225.png
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 20个

财富等级: 恭喜发财

发表于 2018-6-5 15:38:21 | 显示全部楼层
你这边界是什么边界? 每个实体矩形包围框再求边界?

点评

他的源码更近一步就是求最大图框,而且源码只对xy平面有效,当然这是在另外的图上才能看出来的  详情 回复 发表于 2018-6-5 15:48
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 50个

财富等级: 招财进宝

 楼主| 发表于 2018-6-5 15:48:58 | 显示全部楼层
本帖最后由 君是我的泪 于 2018-6-6 10:38 编辑
marting 发表于 2018-6-5 15:38
你这边界是什么边界? 每个实体矩形包围框再求边界?

就是你说的图框再求图框,只要长方形就好了,他的源码更近一步就是求最大图框,而且源码只对xy平面有效,当然这是在另外的图上才能看出来的,平面最好放在z最高的那一面
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-3-29 19:17 , Processed in 0.457117 second(s), 42 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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