block:get-clip-boundary 取剪裁块参照的边界线点WCS坐标

vitalgg

1. (defun block:get-clip-boundary (blkref / ent-sf boundary-in-blk mt ms mr)
   
2.   "取剪裁块参照的边界线点WCS坐标"
   
3.   "list"
   
4.   "(block:get-clip-boundary (car(ensel)))"
   
5.   ;; ent-sf 为剪裁边界线图元
   
6.   (if (setq ent-sf (entity:getdxf (entity:getdxf (entity:getdxf blkref 360) 360)360))
   
7.       (progn
   
8.   (setq matrixs (list:split (entity:getdxf ent-sf 40)  12)) ;; 取WCS到OCS(块内)坐标变换矩阵
   
9.   ;; 取边界顶点坐标
   
10.   (setq pts (entity:getdxf ent-sf 10))
    
11.   ;; 处理矩形两点变四点
    
12.   (if (= 2 (length pts))
    
13.       (setq pts  (apply 'point:rec-2pt->4pt pts)))
    
14.   ;; 进行 WCS到OCS(块内)坐标变换，得到边界顶点在块内的坐标。
    
15.   (setq boundary-in-blk
    
16.         (mapcar'(lambda(x)(matrix:mxp (list:split (car matrixs) 4) x)) pts))
    
17.   ;; 构造块参照的平移变换矩阵
    
18.   (setq mt (apply 'matrix:translation (entity:getdxf blkref 10)))
    
19.   ;; 构造块参照的缩放变换矩阵
    
20.   (setq ms (matrix:scale (entity:getdxf  blkref 41)
    
21.              (entity:getdxf  blkref 42)
    
22.              (entity:getdxf  blkref 43)))
    
23.   ;; 构造块参照的旋转变换矩阵
    
24.   (setq mr (matrix:rotation-z (- (*  2 pi)(entity:getdxf blkref 50))))
    
25.   ;; OCS到块参照的WCS坐标变换
    
26.   (mapcar '(lambda(x)
    
27.       (matrix:transform
    
28.        mt ms mr x))
    
29.     boundary-in-blk)
    
30.   )))
    

(defun block:get-clip-boundary (blkref / ent-sf boundary-in-blk mt ms mr)<br />   "取剪裁块参照的边界线点WCS坐标"<br />   "list"<br />   "(block:get-clip-boundary (car(ensel)))"<br />   ;; ent-sf 为剪裁边界线图元<br />   (if (setq ent-sf (entity:getdxf (entity:getdxf (entity:getdxf blkref 360) 360)360))<br />       (progn<br />   (setq matrixs (list:split (entity:getdxf ent-sf 40)  12)) ;; 取WCS到OCS(块内)坐标变换矩阵<br />   ;; 取边界顶点坐标<br />   (setq pts (entity:getdxf ent-sf 10))<br />   ;; 处理矩形两点变四点<br />   (if (= 2 (length pts))<br />       (setq pts  (apply 'point:rec-2pt->4pt pts)))<br />   ;; 进行 WCS到OCS(块内)坐标变换，得到边界顶点在块内的坐标。<br />   (setq boundary-in-blk<br />         (mapcar'(lambda(x)(matrix:mxp (list:split (car matrixs) 4) x)) pts))<br />   ;; 构造块参照的平移变换矩阵<br />   (setq mt (apply 'matrix:translation (entity:getdxf blkref 10)))<br />   ;; 构造块参照的缩放变换矩阵<br />   (setq ms (matrix:scale (entity:getdxf  blkref 41)<br />              (entity:getdxf  blkref 42)<br />              (entity:getdxf  blkref 43)))<br />   ;; 构造块参照的旋转变换矩阵<br />   (setq mr (matrix:rotation-z (- (*  2 pi)(entity:getdxf blkref 50))))<br />   ;; OCS到块参照的WCS坐标变换<br />   (mapcar '(lambda(x)<br />       (matrix:transform<br />        mt ms mr x))<br />     boundary-in-blk)<br />   )))<br />

代码中相关函数见 @lisp函数库。代码仅供相互探讨学习实现原理。不能直接复制使用。

可以使用以下代码直接从网络加载 @lisp 函数库到CAD中，然后直接调用该函数。

1. (progn(vl-load-com)(setq s strcat h"http"o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://""atlisp.""cn/cloud"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get o'ResponseText))))
   

(progn(vl-load-com)(setq s strcat h"http"o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://""atlisp.""cn/cloud"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get o'ResponseText))))<br />

更多函数功能说明请至：  https://atlisp.cn/functionlib.html


也可以在 VScode 中安装 @lisp扩展，直接查看和使用 @lisp函数。 https://marketplace.visualstudio ... talGG.atlisp-funlib