社区 › AutoLISP/Visual LISP 编程技术 › 寻求大师帮忙编个双向偏移有交点自动剪裁LSP

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

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

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

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

;;单线变双线 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:00

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

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


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

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

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

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

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

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

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

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

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

xyp1964 发表于 2016-5-13 13:55 static/image/common/back.gif


非常感谢！

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

Gu_xl 发表于 2016-5-13 16:03 static/image/common/back.gif


非常感谢二位大神！

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

院长伪源码都收币了啊

查看完整版本: 寻求大师帮忙编个双向偏移有交点自动剪裁LSP