congcong 发表于 2003-1-2 19:40:00

如何删除重复线?困扰我十几个月了的一个大问题

如果有三根直线重叠,那么看上去就像只有一条线,但这种线如果让线切割割的话是会出问题的,线切割会重复走这几根线的路径。
我想要的是如何删除这些重复的线,但是不能删除后出现丢失线段的现像。

即一根线从座标
(0 0) 到 (50 0),另一根线从 (30 0)到 (100 0) 那么这两根线重叠,但是删除重复线后我所要的线一定要是从(0 0) 到 (100 0) 的一根线,烦劳各位大师帮忙解决这个大问题。
做冲压模具设计的工程师若用过Press CAD,想必一定知道此软件具备上述我所要的功能。

langjs 发表于 2011-11-24 12:04:44

以前在明经下载的程序:
;;; ===========================================================
;;; 图元合并(删除图纸中重叠的线、圆、圆弧、块)
;;; 命令:tyhb
;;; ===========================================================
(defun c:tyhb (/ arc_list ent i line_list ss)
(setvar "cmdecho" 0)               ; 关闭命令响应
(command ".UNDO" "BE")
(while (and
         (setq ss (ssget (list (cons -4 "<or") (cons 0 "arc") (cons 0 "CIRCLE") (cons 0 "line") (cons 0 "INSERT") (cons -4 "or>"))))
         (> (sslength ss) 0)
         )
    (hbzhx ss)
)
(command ".UNDO" "E")
(princ)
)
(defun cs_pross (to i / cs_text myi)
(setq cs_text ">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>")
(setq myi (fix (/ (* (strlen cs_text) i) to))
      cs_text (substr cs_text 1 myi)
)
(grtext -2 cs_text)
)
(defun hbzhx (ss / arc_list ent i line_list ss jd) ;   转为数据表
(grtext -2 "正在整理数据")
(setq i 0
      jd 1e-5
      line_list '()
      arc_list '()
      ss100 (ssadd)
)
(repeat (sslength ss)
    (setq ent (ssname ss i)
          i (1+ i)
    )
    (if (= "INSERT" (cdr (assoc 0 (entget ent))))
      (ssadd ent ss100)
      (if (= "LINE" (cdr (assoc 0 (entget ent))))
      (setq line_list (cons (line_data ent) line_list))
      (setq arc_list (cons (arc_data ent) arc_list))
      )
    )
)
(setq ss100 (congfukuai ss100))
(setq line_list (vl-sort line_list '(lambda (e1 e2)
                                        (if (equal (car e1) (car e2) jd)
                                          (if (equal (cadr e1) (cadr e2) jd)
                                          (if (equal (car (caddr e1)) (car (caddr e2)) jd)
                                              (< (cadr (caddr e1)) (cadr (caddr e2)))
                                              (< (car (caddr e1)) (car (caddr e2)))
                                          )
                                          (< (cadr e1) (cadr e2))
                                          )
                                          (< (car e1) (car e2))
                                        )
                                    )
                  )
)
(setq arc_list (vl-sort arc_list '(lambda (e1 e2)
                                    (if (equal (car e1) (car e2) jd)
                                        (if (equal (cadr e1) (cadr e2) jd)
                                          (if (equal (caddr e1) (caddr e2) jd)
                                          (< (cadddr e1) (cadddr e2))
                                          (< (caddr e1) (caddr e2))
                                          )
                                          (< (cadr e1) (cadr e2))
                                        )
                                        (< (car e1) (car e2))
                                    )
                                    )
               )
)
(if line_list
    (hb_line line_list jd)
)
(if arc_list
    (hb_arc arc_list jd)
)
(grtext)
(princ)
)
(defun hb_line (line_list jd / b biaoji data ent k line_a line_b p1 p2 p3 p4 p5 jd xuhao zongshu i lay)
(setq zongshu (length line_list)
      i 0
      xuhao 0
)
(princ (strcat "\n共处理" (rtos zongshu) "个实体"))
(grtext -1 "合并直线")
(while (> (length line_list) 0)
    (setq xuhao (1+ xuhao))
    (cs_pross zongshu xuhao)
    (setq line_a (car line_list)
          line_list (cdr line_list)
          biaoji t
          k (car line_a)
          b (cadr line_a)
          p1 (caddr line_a)
          p2 (cadddr line_a)
          ent (last line_a)
          lay (cdr (assoc 8 (entget ent)))
    )
    (while (and
             biaoji
             (> (length line_list) 0)
         )
      (setq line_b (car line_list))
      (cond
      ((and
         (equal k (car line_b) jd)
         (equal b (cadr line_b) jd)
         (= lay (cdr (assoc 8 (entget (last line_b)))))
         )
          (setq p3 (caddr line_b)
                p4 (cadddr line_b)
                p5 (vl-sort (list p1 p2 p3 p4) '(lambda (e1 e2)
                                                (if (equal (car e1) (car e2) jd)
                                                    (< (cadr e1) (cadr e2))
                                                    (< (car e1) (car e2))
                                                )
                                                )
                   )
                p4 (cadr p5)
          )
          (if (or
                (equal p1 p4 jd)
                (equal p3 p4 jd)
            )
            (progn
            (setq p1 (car p5)
                  p2 (last p5)
                  line_list (cdr line_list)
            )
            (entdel (last line_b))
            (setq xuhao (1+ xuhao))
            (cs_pross zongshu xuhao)
            (setq i (1+ i))
            )
            (setq biaoji nil)
          )
      )
      (t
          (setq biaoji nil)
      )
      )
    )
    (setq data (entget ent)
          data (subst
               (cons 10 p1)
               (assoc 10 data)
               data
               )
          data (subst
               (cons 11 p2)
               (assoc 11 data)
               data
               )
    )
    (entmod data)
)
(princ (strcat ",删除了" (rtos i) "个实体"))
(princ)
)
(defun hb_arc (arc_list jd / i arc_a arc_b biaoji bj data eangl eangl1 ent jd line_list p5 pc sangl sangl1 xuhao zongshu lay)
(setq zongshu (length arc_list)
      xuhao 0
      i 0
)
(princ (strcat "\n共处理" (rtos zongshu) "个实体"))
(grtext -1 "合并圆弧")
(while (> (length arc_list) 0)
    (setq xuhao (1+ xuhao))
    (cs_pross zongshu xuhao)
    (setq arc_a (car arc_list)
          arc_list (cdr arc_list)
          biaoji t
          bj (car arc_a)
          pc (list (cadr arc_a) (caddr arc_a))
          sangl (cadddr arc_a)
          eangl (nth 4 arc_a)
          ent (last arc_a)
          lay (cdr (assoc 8 (entget ent)))
    )
    (while (and
             biaoji
             (> (length arc_list) 0)
         )
      (setq arc_b (car arc_list))
      (cond
      ((and
         (equal bj (car arc_b) jd)
         (equal pc (list (cadr arc_b) (caddr arc_b)) jd)
         (= lay (cdr (assoc 8 (entget (last arc_b)))))
         )
          (setq sangl1 (cadddr arc_b)
                eangl1 (nth 4 arc_b)
                p5 (vl-sort (list sangl eangl sangl1 eangl1) '(lambda (e1 e2)
                                                                (< e1 e2)
                                                            )
                   )
                sangl1 (nth (- (length p5) 2) p5)
          )
          (if (or
                (equal eangl sangl1 jd)
                (equal eangl1 sangl1 jd)
            )
            (progn
            (setq sangl (car p5)
                  eangl (last p5)
                  arc_list (cdr arc_list)
            )
            (entdel (last arc_b))
            (setq xuhao (1+ xuhao))
            (cs_pross zongshu xuhao)
            (setq i (1+ i))
            )
            (setq biaoji nil)
          )
      )
      (t
          (setq biaoji nil)
      )
      )
    )
    (setq data (entget ent)
          data (subst
               (cons 50 sangl)
               (assoc 50 data)
               data
               )
          data (subst
               (cons 51 eangl)
               (assoc 51 data)
               data
               )
    )
    (entmod data)
)
(princ (strcat ",删除了" (rtos i) "个实体"))
(princ)
)
(defun arc_data (ent / bj data eangl pc sangl)
(setq data (entget ent))
(setq bj (cdr (assoc 40 data)))
(setq pc (cdr (assoc 10 data)))
(setq sangl (cdr (assoc 50 data)))
(setq eangl (cdr (assoc 51 data)))
(if (not sangl)
    (setq sangl 0.0
          eangl (+ pi pi)
    )
)
(if (< eangl sangl)
    (setq eangl (+ eangl (+ pi pi)))
)
(list bj (car pc) (cadr pc) sangl eangl ent)
)
(defun line_data (ent / b k p1 p2 jd)
(setq p1 (vlax-curve-getstartpoint ent)
      p2 (vlax-curve-getendpoint ent)
      jd 1e-5
)
(if (equal (car p1) (car p2) jd)
    (setq k nil
          b (car p1)
    )
    (setq k (/ (- (cadr p2) (cadr p1)) (- (car p2) (car p1)))
          b (- (cadr p1) (* (car p1) k))
    )
)
(setq p2 (vl-sort (list p1 p2) '(lambda (e1 e2)
                                    (if (equal (car e1) (car e2) jd)
                                    (< (cadr e1) (cadr e2))
                                    (< (car e1) (car e2))
                                    )
                                  )
         )
      p1 (car p2)
      p2 (cadr p2)
)
(list k b (list (car p1) (cadr p1)) (list (car p2) (cadr p2)) ent)
)
;;; -------------------------------------------------------------
;;; 删除重块
(defun congfukuai (ss / i layb n ss1 ss88 ss99 ssb ssb0 ssn ssn1 u)
(setq u 0
        ss88 (ssadd)
        ss99 (ssadd)
)
(while (< u (sslength ss))
    (setq ssn (ssname ss u))
    (ssadd ssn ss88)
    (ssadd ssn ss99)
    (setq u (+ u 1))
)
(setq n 0
        ss1 (ssadd)
)
(while (< n (sslength ss))
    (setq ssn (ssname ss n))
    (setq layb (assoc '8 (entget ssn)))
    (setq ssb0 (member layb (entget ssn)))
    (setq i 0)
    (ssdel ssn ss88)
    (while (< i (sslength ss88))
      (setq ssn1 (ssname ss88 i))
      (setq layb (assoc '8 (entget ssn1)))
      (setq ssb (member layb (entget ssn1)))
      (if (equal ssb0 ssb)
        (progn
          (ssadd ssn1 ss1)
          (ssdel ssn1 ss99)
        )
      )
      (setq i (+ i 1))
    )
    (setq n (+ n 1))
)
(setq n (sslength ss1))
(princ (strcat "删除了" (rtos n 2 0) "个重块!"))
(command "erase" ss1 "")
SS99
)

陈小五 发表于 2023-2-9 23:55:39

简简单单就好 发表于 2023-1-3 21:19
楼主能分享一下你研究出来的源码么?我也是激光切割总是被重复线搞的很麻烦

你是全部拍好板直接导进软件出下料程序吗

简简单单就好 发表于 2023-1-3 21:19:05

楼主能分享一下你研究出来的源码么?我也是激光切割总是被重复线搞的很麻烦

matichen 发表于 2003-1-3 13:28:00

如果你用2000/2002 的话,装EXPRESS TOOLS (就是那个快捷工具栏),然后用overkill命

如果你用2000/2002 的话,装EXPRESS TOOLS (就是那个快捷工具栏),然后用overkill命令

amos_lg 发表于 2003-1-5 16:35:00

这样用

你选中重复的这两条线(重叠部分将会实线显示,其余部分为虚线),选中其中一条线末端的夹点托拽到另一条线的末端即可

aeo000000 发表于 2003-2-16 13:36:00

这里没人说到晓东工具箱xd_api里就有,www.xdcad.net 里面有现成的,还有这方面的讨论

这里没人说到晓东工具箱xd_api里就有,www.xdcad.net 里面有现成的,还有这方面的讨论.天正也有,就是不同专业

congcong 发表于 2003-2-22 15:33:00

谢谢各位的指导,我已经自己编写出来这个程序了,很适合用于冲模设计!

spring 发表于 2003-2-23 15:31:00

没有这个命令啊

w245272914 发表于 2011-10-22 14:47:24

楼主。你好。可以发我吗? 交个朋友。我刚买猫老师的视频刚学不久。   317198714@QQ.COM   谢谢啦。

k1nger 发表于 2011-10-22 16:45:40

(princ "\n命令:scf")
(defun c:scf ()
(sfff "lwpolyline")
(sfff "line")
(sfff "point")
(sfff "text")
(sfff "insert")

)
(defun sfff (ffff)
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(command "convertpoly" "l" "all" "")
   
(setq aa (ssget "x" (list (cons 0 ffff))))
(if aa
    (progn

      (setq len1 (sslength aa)
   n0
      )
      (repeat len1
(setq aa1 (ssname aa n))
(setq n (+ n 1))
(setq bb (entget aa1 '("*")))
(setq zb1 (cdr (assoc 10 bb)))
(setq tc (cdr (assoc 8 bb)))
(setq jb1 (cdr (assoc 5 bb)))
(setq w100 (assoc 100 bb))
(setq w101 (member w100 bb))

(setq px1 (car zb1)
       py1 (cadr zb1)
)
(setq px2 (- px1 5)
       px3 (+ px1 5)
)
(setq py2 (- py1 5)
       py3 (+ py1 5)
)
(setq pn2 (list px2 py2)
       pn3 (list px3 py3)
)
(command "zoom" "c" pn2 20)
(setq ls-s (ssget "c" pn2 pn3 (list (cons 0 ffff) (cons 8 tc))))
(if ls-s
   (progn
   (setq lens (sslength ls-s)
    ns   0
   )
   (if (> lens 1)
       (progn
(repeat lens
    (setq aas (ssname ls-s ns))
    (setq ns (+ ns 1))
    (setq wbb (entget aas '("*")))
    (setq jb2 (cdr (assoc 5 wbb)))
    (setq ww100 (assoc 100 wbb))
    (setq ww101 (member ww100 wbb))
    (if (/= jb1 jb2)
      (progn
      (if (= (equal w101 ww101) t)
   (command "erase" aa1 "")
      )
      )
    )
)

       )

   )    ;if (> lens 1)
   )
)    ;if ls-s

      )   ;repeat len1
    )
)
(command "convertpoly" "h" "all" "")

)

酥果 发表于 2011-10-25 10:02:56

请问8l楼,怎么调用?scf?

k1nger 发表于 2011-10-27 11:14:40

酥果 发表于 2011-10-25 10:02 static/image/common/back.gif
请问8l楼,怎么调用?scf?

对,scf调用
页: [1] 2 3
查看完整版本: 如何删除重复线?困扰我十几个月了的一个大问题