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

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
)
)

(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:

游客，如果您要查看本帖隐藏内容请回复

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

看下，学习下

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

不错，学习了。

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

学习再学习
来自: 微社区

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

[求助] 如何删除掉多段线中间的弧线段

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分