[求助]：将连续的线段连成多义线

lt_zzy

我使用得一个软件导出来的总体图（CAD图），坡脚线是连续的线段，而我所需要的是多义线，因为后续的工作要用到坡脚线，这些线段的端头是互相连接的，线段的端头几乎不与其他线段相边，用mpedit命令实在是不好选择，因为不想将其他的线段转化成多义线。
请各位帮帮忙，给我写一个LSP，VLSP，或者其他的CAD里可以执行的程序，实现如下功能：
选择这些线段的一条，端头的或中间的，然后程序自动找到这些相连的线段，并将他们连接成多义线。

陌生人

lsjjm前几天就写过这么一个程序呢

lt_zzy

我用得是你完善后的那个，有一个错误，请长老指点！
http://www.xdcad.net/forum/showt ... 1124408#post1124408
错误: 参数类型错误: lselsetp nil

ll_j

你直接使用Pedit命令试试，Join时只管选就是了，其他不相干的线时不会变的。
给一个思路，供大家参考：
(command "pedit" pause "y" "j" "all" """")
这里all的选择与pause的选择在编程时可以过滤一下。

陌生人

没选中？用楼上的方法也行，反正你不是要选集，而是直接转多义线

lt_zzy

最初由 ll_j 发布
[B]你直接使用Pedit命令试试，Join时只管选就是了，其他不相干的线时不会变的。
给一个思路，供大家参考：
(command "pedit" pause "y" "j" "all" """")
这里all的选择与pause的选择在编程时可以过滤一下。 [/B]

长老，你的方法可以实现，但是有一个问题：图形大的时候，识别要很长时间。

黄卫文

前提：“这些线段的端头是互相连接的，线段的端头几乎不与其他线段相连”
[php]
(defun c:pl-test (/ ename elist layname pt10 pt11 ss num  pl-list pl_list_1 pl_list_3 p10 p11)   
  (if (and (setq ename (entsel))
           (setq ename (car ename))
           (setq elist (entget ename))
           (member '(0 . "LINE") elist)
      )
    (progn
      (command "zoom" "e")
      (setq layname (cdr (assoc 8 elist))
            pt10    (cdr (assoc 10 elist))
            pt11    (cdr (assoc 11 elist))
      )      
      (setq pl-list (list (cons 10 (list (car pt10) (cadr pt10)))
                          '(40 . 0.0)
                          '(41 . 0.0)
                          '(42 . 0.0)
                          (cons 10 (list (car pt11) (cadr pt11)))
                          '(40 . 0.0)
                          '(41 . 0.0)
                          '(42 . 0.0)
                    )
      )
      (entdel ename)
      (while (and (setq        ss (ssget "c"
                                  (mapcar '+ pt10 '(1e-3 1e-3 0.0))
                                  (mapcar '- pt10 '(1e-3 1e-3 0.0))
                                  (list        '(0 . "LINE")
                                        (cons 8 layname)
                                        '(-4 . "<OR")
                                        '(-4 . "=,=,=")
                                        (cons 10 pt10)
                                        '(-4 . "=,=,=")
                                        (cons 11 pt10)
                                        '(-4 . "OR>")
                                  )
                           )
                  )
                  (= (sslength ss) 1)
                  (setq ename (ssname ss 0))
             )
        (if (member (cons 10 pt10) (entget ename))
          (setq pt10 (cdr (assoc 11 (entget ename))))
          (setq pt10 (cdr (assoc 10 (entget ename))))
        )       
        (setq pl-list (append (list (cons 10 (list (car pt10) (cadr pt10)))
                                    '(40 . 0.0)
                                    '(41 . 0.0)
                                    '(42 . 0.0)
                              )
                              pl-list
                      )
        )
        (entdel ename)
      )
      ;(setq ename (cdr (assoc -1 elist)))
      (while (and (setq        ss (ssget "c"
                                  (mapcar '+ pt11 '(1e-3 1e-3 0.0))
                                  (mapcar '- pt11 '(1e-3 1e-3 0.0))
                                  (list        '(0 . "LINE")
                                        (cons 8 layname)
                                        '(-4 . "<OR")
                                        '(-4 . "=,=,=")
                                        (cons 10 pt11)
                                        '(-4 . "=,=,=")
                                        (cons 11 pt11)
                                        '(-4 . "OR>")

                                  )
                           )
                  )
                  (= (sslength ss) 1)
                  (setq ename (ssname ss 0))
             )
        (if (member (cons 10 pt11) (entget ename))
          (setq pt11 (cdr (assoc 11 (entget ename))))
          (setq pt11 (cdr (assoc 10 (entget ename))))
        )
        (setq pl-list (append pl-list
                              (list (cons 10 (list (car pt11) (cadr pt11)))
                                    '(40 . 0.0)
                                    '(41 . 0.0)
                                    '(42 . 0.0)
                              )
                      )
        )
        (entdel ename)
      )
      (setq num              (/ (length pl-list) 4)
            pl_list_1 (list '(0 . "LWPOLYLINE")
                            '(100 . "AcDbEntity")
                            '(67 . 0)
                            (cons 8 layname)                            
                            '(100 . "AcDbPolyline")
                            (cons 90 num)
                            '(70 . 0)
                            '(43 . 0.0)
                            '(38 . 0.0)
                            '(39 . 0.0)
                      )
            pl_list_3 '((210 0.0 0.0 1.0))
      )
      (entmake (append (append pl_list_1  pl-list) pl_list_3))
      (princ)
    )
  )
)

[/php]

雪山飞狐(lzh)

代码里使用了or做过滤器，楼上的最好存成文件发上来

黄卫文

前提：“这些线段的端头是互相连接的，线段的端头几乎不与其他线段相连”

lt_zzy

好程序，建议版主加分。

falconry

提个问题，如果这些线段中有曲线该怎么做？

aeo

很早就贴过
http://www.xdcad.net/forum/showt ... pagenumber=1&s=

用的递归
可能有点bug.不过问题不大。
get-line得到和实体e0连的线


下面去掉了xd_api的几个函数:
把原来要相同图层的过滤去掉了.
[php]
(defun c:pj (/ e ss dxf get-line)
;;;BY Aeo
  (defun get-line (e0 / li-e get-line1 ss )
    (setq li-e (list e0))
    (defun get-line1 (e0 / en en1 lay li-ss li-ss-del p1 p2 p3 p4 ss ss1 ss2)
      (setq p2 (vlax-curve-getEndPoint e0)
            p1 (vlax-curve-getstartPoint e0)
      )
      (setq ss1 (ssget "c" (polar p1 (* pi 1.25) 40) (polar p1 (* pi 0.25)
                                                            40
                                                     )                 )
      )
      (setq ss2 (ssget "c" (polar p2 (* pi 1.25) 40) (polar p2 (* pi 0.25)
                                                            40
                                                     )                 )
      )
      
      (setq ss nil
            li-ss nil
            j 0
      )
      (if ss1(repeat(sslength ss1)(setq ss(cons(ssname ss1 j) ss) j(1+ j))))
      (setq j 0)
      (if ss2(repeat(sslength ss2)(setq ss(cons(ssname ss2 j) ss) j(1+ j))))
      (foreach e ss
        (setq p3 (vlax-curve-getEndPoint e)
              p4 (vlax-curve-getstartPoint e)
        )
        (if (or
              (equal p3 p1 1e-3)
              (equal p4 p1 1e-3)
              (equal p3 p2 1e-3)
              (equal p4 p2 1e-3)
            )
          (setq li-ss (cons e li-ss))
        )
      )
      (setq li-ss-del '())
      (foreach x li-ss
        (if (not (member x li-e))
          (setq li-e (cons x li-e)
                li-ss-del (cons x li-ss-del)
          )
        )
      )
      (if (> (length li-ss-del) 0)
        (foreach x li-ss-del
          (get-line1 x)
        )
      )
      li-e
    )
    (get-line1 e0)
    (setq ss (ssadd))
    (foreach x li-e
      (ssadd x ss)
    )
  )
  (defun dxf (a b)
    (cdr (assoc a b))
  )
  ;;;.....................................................;;;
  (if (and(setq e (car(entsel "\n选多义线，直线，弧线:" )))
          (wcmatch(dxf 0 (entget e))  "*POLYLINE,LINE,ARC")
          (setq  ss (get-line e))
      )
      (cond
        ((and
           (wcmatch (dxf 0 (entget e)) "*POLYLINE")
           (/= 1 (dxf 70 (entget e)))
         )
          (command "pedit" e "j" ss "" "")
          (princ "\n连上了.")
        )
        ((and
           (wcmatch (dxf 0 (entget e)) "*POLYLINE")
           (= 1 (dxf 70 (entget e)))
         )
          (princ "\n闭合的多义线")
        )
        (t
          (command "pedit" e "y" "j" ss "" "")
          (princ "\n连上了.")
        )
      )
  )
  (prin1)
)
[/php]

条件要：选的东东在屏幕里面.
我没判断这一条
我用的时候正好可以用屏幕来避开不要连起来的.

陌生人

运算量大的时候，用递归可能会溢出

maoding

斑竹、高手们我可以提个建议吗
当你们发布程序是可以将要点备注
或者做个简短的介绍吗
我们学习起来不会那么费力了

陌生人

你可以先看一些简单的程序，慢慢来嘛
功能，参数，返回值我一向是简易写上的，自己以后看也方便。
但是对过程的处理，如果要写分析的话，不如另外设个源码分析的板块，专门注解，分析程序的。
我觉得你的简易不错：），对初学的确是很有帮助的