block:get-clip-boundary 取剪裁块参照的边界线点WCS坐标
本帖最后由 vitalgg 于 2024-4-12 20:18 编辑(defun block:get-clip-boundary (blkref / ent-sf boundary-in-blk mt ms mr)
"取剪裁块参照的边界线点WCS坐标"
"list"
"(block:get-clip-boundary (car(ensel)))"
;; ent-sf 为剪裁边界线图元
(if (setq ent-sf (entity:getdxf (entity:getdxf (entity:getdxf blkref 360) 360)360))
(progn
(setq matrixs (list:split (entity:getdxf ent-sf 40)12)) ;; 取WCS到OCS(块内)坐标变换矩阵
;; 取边界顶点坐标
(setq pts (entity:getdxf ent-sf 10))
;; 处理矩形两点变四点
(if (= 2 (length pts))
(setq pts(apply 'point:rec-2pt->4pt pts)))
;; 进行 WCS到OCS(块内)坐标变换，得到边界顶点在块内的坐标。
(setq boundary-in-blk
(mapcar'(lambda(x)(matrix:mxp (list:split (car matrixs) 4) x)) pts))
;; 构造块参照的平移变换矩阵
(setq mt (apply 'matrix:translation (entity:getdxf blkref 10)))
;; 构造块参照的缩放变换矩阵
(setq ms (matrix:scale (entity:getdxfblkref 41)
(entity:getdxfblkref 42)
(entity:getdxfblkref 43)))
;; 构造块参照的旋转变换矩阵
(setq mr (matrix:rotation-z (- (*2 pi)(entity:getdxf blkref 50))))
;; OCS到块参照的WCS坐标变换
(mapcar '(lambda(x)
(matrix:transform
mt ms mr x))
boundary-in-blk)
)))
代码中相关函数见 @lisp函数库。代码仅供相互探讨学习实现原理。不能直接复制使用。
可以使用以下代码直接从网络加载 @lisp 函数库到CAD中，然后直接调用该函数。
(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))))
更多函数功能说明请至：https://atlisp.cn/functionlib.html
也可以在 VScode 中安装 @lisp扩展，直接查看和使用 @lisp函数。 https://marketplace.visualstudio.com/items?itemName=VitalGG.atlisp-funlib
页:
[1]