【OFFSET】点表双侧偏移
本帖最后由 kucha007 于 2025-2-1 13:40 编辑点表双侧偏移，类似Offest的方法，不过不支持弧线。用于我的云线插件：http://bbs.mjtd.com/forum.php?mod=viewthread&tid=186837&page=1&extra=#pid934925
在论坛找了半天只找到了这个帖子，于是只好自己写了:
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=108141&fromuid=7329538
;根据UCS折线点表生成两侧偏移的折线
(defun K:GetOFFPL (UCSLst RvCol / K:DynOffUCSLst StaPt Code TmpLst i Key EntNam)
;点表偏移多段线
(defun K:DynOffUCSLst (UCSLst Dst / i StaPT NxtPT Ang FstLst SecLst TmpLst K:INPLst)
;求偏移后的UCS每段的交点成UCS点表
(defun K:INPLst (TmpLst / i SL EL RtnLst)
(setq i 0)
(while (< i (1- (length TmpLst)))
(setq SL (nth i TmpLst)
EL (nth (setq i (1+ i)) TmpLst)
)
(if (setq InP (inters (car SL) (cadr SL) (car EL) (cadr EL) nil));无限长求交点
(setq RtnLst (cons InP RtnLst))
)
)
(setq RtnLst (append (list (car (car TmpLst))) (reverse RtnLst) (list (cadr (Last TmpLst)))))
)
(setq FstLst Nil SecLst Nil)
(setq i 0);初始化
(while (< i (1- (length UCSLst)))
(progn
(setq StaPT (nth i UCSLst);UCS
NxtPT (nth (setq i (1+ i)) UCSLst);UCS
)
(setq Ang (- (angle StaPT NxtPT) (* 0.5 pi)))
(while (minusp Ang)(setq Ang (+ Ang (* 2 pi))))
(setq FstLst (cons (list (polar StaPT Ang (+ 0 Dst)) (polar NxtPT Ang (+ 0 Dst))) FstLst)
SecLst (cons (list (polar StaPT Ang (- 0 Dst)) (polar NxtPT Ang (- 0 Dst))) SecLst)
)
)
);分段两侧偏移
(setq TmpLst (append (K:INPLst (reverse FstLst)) (reverse (K:INPLst (reverse SecLst)))))
TmpLst
)
;点表生成多段线
(defun K:MakeLWPOLYLINE (WCS Clsd PTLst / PT)
(entmakeX
(append
(list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 90 (length PTLst))
)
(if Clsd (list (cons 70 1)))
(mapcar '(lambda (PT)
(cons 10
(if WCS PT (trans PT 1 0))
)
)
PTLst
)
)
)
)
(if (and UCSLst (>= (length UCSLst) 2))
(progn
(setq StaPt (Last UCSLst));UCS
(while
(progn
(princ "\n→请指定偏移距离<或空格>: ")
(while (and (setq Code (grread T (+ 1 4 8))) (eq (car Code) 5))
(redraw)
(grdraw StaPt (cadr Code) RvCol);长度线
(setq TmpLst (K:DynOffUCSLst UCSLst (distance StaPt (cadr Code))))
(setq i 0);初始化
(while (< i (length TmpLst))
(if (= (setq i (1+ i)) (length TmpLst));最后一个
(grdraw (Last TmpLst) (car TmpLst) RvCol)
(grdraw (nth (1- i) TmpLst) (nth i TmpLst) RvCol)
)
);显示线
);显示预览
(setq Key (cadr Code))
(cond
((and (eq (car Code) 3) (eq (type Key) 'LIST));点选
(redraw)
(setq EntNam (K:MakeLWPOLYLINE Nil T (K:DynOffUCSLst UCSLst (distance StaPt (cadr Code)))))
Nil ;退出循环
)
((equal Code '(2 32));空格
(redraw)
(setq EntNam (K:MakeLWPOLYLINE Nil T(K:DynOffUCSLst UCSLst (distance StaPt (cadr (grread '(2 32)))))))
Nil ;退出循环
)
(T Nil)
)
)
)
EntNam
)
)
)
补充一个基础函数：
;选取多个UCS点用于生成多段线
(defun K:GetUCSPTLst (StaPT BGCol / UCSLst TgtPT)
(setq UCSLst Nil)
(if (car (setq UCSLst (list StaPT)))
(while
(setq TgtPT (if (>= (length UCSLst) 2);至少两个点
(progn
(initget "U")
(getpoint (car UCSLst) "\n→请指定下一点或空格结束[撤回(U)]: ")
)
(getpoint (car UCSLst) "\n→请指定下一点或空格结束:")
)
)
(redraw)
(mapcar
'(lambda (a b) (grdraw a b BGCol 1))
(setq UCSLst (if (eq TgtPT "U")
(cdr UCSLst)
(cons TgtPT UCSLst)
)
)
(cdr UCSLst)
)
)
)
(princ)(redraw)
(cond ((>= (length UCSLst) 2) (reverse UCSLst)))
)
用法：
(if (and
(setq StaPT (getpoint))
(setq UCSLst (K:GetUCSPTLst StaPT 1))
)
(K:GetOFFPL UCSLst 1)
)
这个真牛逼，谢谢分享。 看起很不错。不过打开这个页面电脑浏览器就卡爆了
页:
[1]