论坛 › A/VLISP › 如何删除掉多段线中间的弧线段

lisp_beginner 发表于 2017-7-27 12:27:42

如何删除掉多段线中间的弧线段

本帖最后由 lisp_beginner 于 2017-7-27 12:43 编辑

如图

marting 发表于 2017-7-27 19:31:59

本帖最后由 marting 于 2017-7-27 19:33 编辑


(defun c:tt (/ enx hed idx int lst ocs rtn sel)
(if (setq sel      (ssget "_:L"
                     '((0 . "LWPOLYLINE")
                         (-4 . "<NOT")
                         (-4 . "&=")
                         (70 . 1)
                         (-4 . "NOT>")
                        )
                )
      )
    (repeat (setq idx (sslength sel))
      (setq enx      (entget (ssname sel (setq idx (1- idx))))
            hed      (reverse (member (assoc 38 enx) (reverse enx)))
            ocs      (cdr (assoc 210 enx))
            lst      (lwv-ptb enx)
            rtn      nil
      )
      (while (caddr lst)
      (cond
          ((equal 0.0 (cdr (assoc 42 (car lst))) 1e-8)
         (if (not (and rtn
                         (ptonline (cdar rtn)
                                 (cdr (assoc 10 (car lst)))
                                 (cdr (assoc 10 (cadr lst)))
                         )
                  )
               )
             (setq rtn (cons (assoc 10 (car lst)) rtn))
         )
          )
          (rtn
         (if (setq int
                      (apply 'inters
                           (append
                               (list (trans (cdar rtn) ocs 1))
                               (mapcar
                                 '(lambda (a b) (trans (cdr (assoc 10 a)) ocs 1))
                                 lst
                                 '(0 1 2)
                               )
                               '(nil)
                           )
                      )
               )
             (setq rtn (cons (cons 10 (trans int 1 ocs)) rtn))
             (setq rtn (cons (assoc 10 (car lst)) rtn))
         )
          )
      )
      (setq lst (cdr lst))
      )
      (while (and (cadr lst)
                  (ptonline (cdar rtn)
                            (cdr (assoc 10 (car lst)))
                            (cdr (assoc 10 (cadr lst)))
                  )
             )
      (setq lst (cdr lst))
      )
      (setq rtn (append (reverse rtn) (mapcar 'car lst)))
      (if (entmake
            (append
            (subst (cons 90 (length rtn)) (assoc 90 hed) hed)
            (reverse rtn)
            (list (cons 210 ocs))
            )
          )
      (entdel (cdr (assoc -1 enx)))
      )
    )
)
(princ)
)
(defun ptonline      (pt1 pt2 pt3)
(equal (distance pt1 pt3)
         (+ (distance pt1 pt2) (distance pt2 pt3))
         1e-8
)
)


lwv-ptb:

**** Hidden Message *****

yoyoho 发表于 2017-7-27 20:29:41

看看，学习学习！！！

sh_h 发表于 2017-7-27 20:50:39

本帖最后由 sh_h 于 2017-7-27 20:58 编辑

回复，向大师学习！！！

;command方式简化版
(defun c:fr0 ()
(command ".fillet" "r" 0)
(command ".fillet" "p")
)

434939575 发表于 2017-7-27 21:35:31

进来看一看@，学习哈！

sicky111 发表于 2017-7-28 00:34:43

不错，学习了。

HLCAD 发表于 2017-7-28 07:55:26

“marting”大师的水平就是高，知识渊博。

lucas3 发表于 2017-7-28 08:33:09

看看，向大师学习

q3_2006 发表于 2017-7-28 09:14:51

只要看到大师代码就收了..

ynhh 发表于 2017-7-28 14:43:15

感谢分享
学习学习再学习

zdarc 发表于 2017-8-16 12:54:38

“我来测试一下，行不行”

819534890 发表于 2017-8-16 16:08:21

回复学习，谢谢

愤怒的菜鸟 发表于 2017-8-17 09:23:56

看下，学习下{:3_46:}

wssczxf 发表于 2019-1-10 20:59:46

不错，学习了。

qyming2000 发表于 2019-1-11 05:05:49

学习再学习

查看完整版本: 如何删除掉多段线中间的弧线段