寻求大师帮忙编个双向偏移有交点自动剪裁LSP

licream · 发表于 2016-5-12 21:37

请教下各位大师，现在有个棘手的问题，手动偏移浪费时间太多，想请下论坛里的大师帮忙解决下我的问题，
例如我画一个矩形，通过一个命令设置偏移值自动生成二边的偏移线，如有交叉线自动双边偏移后的线自动剪裁。例图中的效果。钱不是问题，如有大师能帮忙，请联系我。

Gu_xl · 发表于 2016-5-13 16:03

;;单线变双线 By Gu_xl 需加载XLRX_API支持
(defun c:MakeDblLine
(/ W SCALE D SS PTS LST LST0 NEW CURVES ERASED CP LST1 Doc)
(setq w (getdist "\n宽度<10.0>:"))
(if (null w)
(setq w 10.0)
)
(setq scale (getreal "\n容差比<1.0>"))
(if (null scale)
(setq scale 1.0)
)
(setq d (* 0.5 w))
(if (setq ss (ssget '((0 . "*line,circle,arc,ellipse"))))
(progn
(vla-StartUndoMark
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(setq ss (xlrx-curve-pjion ss))
(setq pts (XLRX-Curve-Inters ss))
(setq ss (XLRX-PickSet->List ss))
(setq lst
(apply
'append
(mapcar
'(lambda (x / a1 a2 p)
(append
(xlrx-curve-getoffsetcurves x d)
(xlrx-curve-getoffsetcurves x (- d))
(if (not (xlrx-curve-isclosed x))
(progn
(setq a1 (+ (* pi 0.5)
(angle '(0 0 0)
(XLRX-Curve-getfirstDeriv
x
(XLRX-Curve-getStartParam x)
)
)
)
a2 (+ (* pi 0.5)
(angle '(0 0 0)
(XLRX-Curve-getfirstDeriv
x
(XLRX-Curve-getEndParam x)
)
)
)
)
(list
(xlrx-make-line
(polar (setq p (XLRX-Curve-getStartPoint x))
a1
d
)
(polar p a1 (- d))
)
(xlrx-make-line
(polar (setq p (XLRX-Curve-getEndPoint x)) a2 d)
(polar p a2 (- d))
)
)
)
)
)
)
ss
)
)
)
(foreach en lst
(setq lst0 (vl-remove en lst))
(setq new (xlrx-copy en))
(if (setq curves (XLRX-Curve-BreakCurve new lst0 t))
(progn
(setq curves (XLRX-PickSet->List curves))
(setq erased nil)
(foreach ent curves
(setq cp (xlrx-curve-midpoint ent))
(if (not
(vl-some '(lambda (x)
(if (< (distance cp x) (* w scale))
(progn
(if (not erased)
(progn
(entdel ent)
(setq erased t)
)
(progn
(setq erased nil)
(setq lst1 (cons ent lst1))
)
)
)
)
)
pts
)
)
(setq lst1 (cons ent lst1)
erased nil
)
)
)
)
(setq lst1 (cons new lst1))
)
)
(xlrx-delete lst)
(xlrx-curve-pjion lst1)
(if (= 8 (logand 8 (getvar 'UNDOCTL)))
(vla-EndUndoMark Doc)
)
)
)
(princ)
)

;;单线变双线 By Gu_xl 需加载XLRX_API支持 
(defun c:MakeDblLine 
       (/ W SCALE D SS PTS LST LST0 NEW CURVES ERASED CP LST1 Doc) 
  (setq w (getdist "\n宽度<10.0>:")) 
  (if (null w) 
    (setq w 10.0) 
  ) 
  (setq scale (getreal "\n容差比<1.0>")) 
  (if (null scale) 
    (setq scale 1.0) 
  ) 
  (setq d (* 0.5 w)) 
  (if (setq ss (ssget '((0 . "*line,circle,arc,ellipse")))) 
    (progn 
      (vla-StartUndoMark 
        (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) 
      ) 
      (setq ss (xlrx-curve-pjion ss)) 
      (setq pts (XLRX-Curve-Inters ss)) 
      (setq ss (XLRX-PickSet->List ss)) 
      (setq lst 
             (apply 
               'append 
               (mapcar 
                 '(lambda (x / a1 a2 p) 
                    (append 
                      (xlrx-curve-getoffsetcurves x d) 
                      (xlrx-curve-getoffsetcurves x (- d)) 
                      (if (not (xlrx-curve-isclosed x)) 
                        (progn 
                          (setq        a1 (+ (* pi 0.5) 
                                      (angle '(0 0 0) 
                                             (XLRX-Curve-getfirstDeriv 
                                               x 
                                               (XLRX-Curve-getStartParam x) 
                                             ) 
                                      ) 
                                   ) 
                                a2 (+ (* pi 0.5) 
                                      (angle '(0 0 0) 
                                             (XLRX-Curve-getfirstDeriv 
                                               x 
                                               (XLRX-Curve-getEndParam x) 
                                             ) 
                                      ) 
                                   ) 
                          ) 
                          (list 
                            (xlrx-make-line 
                              (polar (setq p (XLRX-Curve-getStartPoint x)) 
                                     a1 
                                     d 
                              ) 
                              (polar p a1 (- d)) 
                            ) 
                            (xlrx-make-line 
                              (polar (setq p (XLRX-Curve-getEndPoint x)) a2 d) 
                              (polar p a2 (- d)) 
                            ) 
                          ) 
 
                        ) 
                      ) 
                    ) 
 
                  ) 
                 ss 
               ) 
             ) 
      ) 
      (foreach en lst 
        (setq lst0 (vl-remove en lst)) 
        (setq new (xlrx-copy en)) 
        (if (setq curves (XLRX-Curve-BreakCurve new lst0 t)) 
          (progn 
            (setq curves (XLRX-PickSet->List curves)) 
            (setq erased nil) 
            (foreach ent curves 
              (setq cp (xlrx-curve-midpoint ent)) 
              (if (not 
                    (vl-some '(lambda (x) 
                                (if (< (distance cp x) (* w scale)) 
                                  (progn 
                                    (if        (not erased) 
                                      (progn 
                                        (entdel ent) 
                                        (setq erased t) 
                                      ) 
                                      (progn 
                                        (setq erased nil) 
                                        (setq lst1 (cons ent lst1)) 
                                      ) 
                                    ) 
                                  ) 
                                ) 
                              ) 
                             pts 
                    ) 
                  ) 
                (setq lst1   (cons ent lst1) 
                      erased nil 
                ) 
              ) 
            ) 
          ) 
          (setq lst1 (cons new lst1)) 
        ) 
      ) 
      (xlrx-delete lst) 
      (xlrx-curve-pjion lst1) 
      (if (= 8 (logand 8 (getvar 'UNDOCTL))) 
        (vla-EndUndoMark Doc) 
      ) 
    ) 
  ) 
  (princ) 
)

xyp1964 · 发表于 2016-5-13 10:01

mmaowwang · 发表于 2017-11-24 16:58

xyp1964 发表于 2016-5-13 13:55

您好，我下载加载后，敲命令tt后没什么反应

xyp1964 · 发表于 2016-5-13 08:41

773786668 · 发表于 2016-5-13 10:46

院长已搞定，剩下就剩钱的问题了

aihuyujian · 发表于 2016-5-13 11:33

源泉建筑的轴线变墙可以实现吧

xyp1964 · 发表于 2016-5-13 13:55

本帖最后由 xyp1964 于 2024-4-12 21:59 编辑

licream · 发表于 2016-5-13 17:30

xyp1964 发表于 2016-5-13 13:55

非常感谢！

licream · 发表于 2016-5-13 17:49

Gu_xl 发表于 2016-5-13 16:03

非常感谢二位大神！

sicky111 · 发表于 2016-5-13 23:07

院长伪源码都收币了啊

账号		自动登录	找回密码
密码			注册

[提问] 寻求大师帮忙编个双向偏移有交点自动剪裁LSP

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源

点评