Join line/s and polyline/s which meet on their ends by selecting just one of them

[ctdlc888]

hello great lispers. I wondered of a shorter way to apply in my problem which is to join line/s and polyline/s which meet on their ends by one selection of any of them then voila they are joined, then the command line is in the offset prompt.In the sample drawing (not mine) the lines-polylines are in yellow color which I want to join and offset as in blue situation.Thank you

2cadtutor.dwg

[ReMark]

How are we expecting the polyline/line that is selected to know there is another line/polyline at the selected end to be joined up with? Are we assuming the lisp routine will recognize a shared coordinate?

[ctdlc888]

How are we expecting the polyline/line that is selected to know there is another line/polyline at the selected end to be joined up with? Are we assuming the lisp routine will recognize a shared coordinate?

 

Yes Remark, a shared coordinate. and i think of a new one, by extended intersection in case they do not meet at ends, whichever .

[Dadgad]

Are you familiar with the OVERKILL command?

It offers options for the optimization of lines and polylines.

[BIGAL]

Dadgad thought you were joking yes there is a command OVERKILL.

 

Re magicly joining lines whats wrong with just PE J and a window it automatically finds all the touching lines.

 

Connect the not touching you could do a Pe J window and then use the new pline to work out the intersecting points, then ammend the pline adding/subtracting segments. Pity HPGAPTOL does not work on make plines or does it anyone ?

[Dadgad]

It is a great command, I always use it after SOLPROF to clear out any deadwood and duplicated lines.

I use the shortcall OK.

I also use it in Erection drawings, it will identify and remove duplicated XREFS too.

[ctdlc888]

Not familiar with that, I will read on OVERKILL Dadgad. Also with your 'Pe J and window' BIGAL, i'm curious-what's that. To study Lisp would be hard for me at 54 but i think of how lisp and you guys help.

[BlackBox]

You can also use FILLET (zero radius) for lines that aren't already touching.

[ReMark]

PE is a command alias for Polyline Edit. The "J" refers to the option JOIN. Works with lines and polylines.

[Lee Mac]

Use the following simple code to join the yellow segments in your drawing to form a single continuous LWPolyline:

 

(defun c:pj ( / c p s )
   (if (setq s (ssget "_:L" '((0 . "LINE,ARC,LWPOLYLINE"))))
       (progn
           (setq p (getvar 'peditaccept)
                 c (getvar 'cmdecho)
           )
           (setvar 'peditaccept 1)
           (setvar 'cmdecho 0)
           (command "_.pedit" "_M" s "" "_J" "" "")
           (setvar 'cmdecho c)
           (setvar 'peditaccept p)
       )
   )
   (princ)
)

 

Then perhaps use EXOFFSET to perform the multiple offsets.

[ctdlc888]

Thanks Lee Mac.It prompts to select objects. Can it be done to select any one line/polyline to select all, as in the title of the thread?

[Lee Mac]

Thanks Lee Mac.It prompts to select objects. Can it be done to select any one line/polyline to select all, as in the title of the thread?

 

Just isolate the layer of the yellow segments (LAYISO), window over the objects, then unisolate the layers (LAYUNISO / LAYON).

[ctdlc888]

I have just unified the yellow to one layer and color. Previously when i got it was mixed up with layers(unorganized) from several polygons.I'm interested in post #2 of ReMark.Sorry for much disturbing you

Edited September 9, 2012 by ctdlc888
to edit double entry

[ctdlc888]

hello. But it is cumbersome to select each yellow touching lines & polylines. I just want to select one and everything sharing a common coordinate(endpoint) is selected.

[rkent]

hello. But it is cumbersome to select each yellow touching lines & polylines. I just want to select one and everything sharing a common coordinate(endpoint) is selected.

 

I like your idea, along the lines of the Express Tool FASTSEL, only it would grab everything in a string.

 

However if you start the pedit command, select one yellow section, select Join, then window everything or type all, only items in a string with the first yellow line will be joined.

[Lee Mac]

However if you start the pedit command, select one yellow section, select Join, then window everything or type all, only items in a string with the first yellow line will be joined.

 

This method could even be automated in a similar way to my previous suggestion:

 

(defun c:pj ( / c p s )
   (if (setq s (ssget "_+.:E:S:L" '((0 . "LINE,ARC,LWPOLYLINE"))))
       (progn
           (setq p (getvar 'peditaccept)
                 c (getvar 'cmdecho)
           )
           (setvar 'peditaccept 1)
           (setvar 'cmdecho 0)
           (command "_.pedit" (ssname s 0) "_J" "_All" "" "")
           (setvar 'cmdecho c)
           (setvar 'peditaccept p)
           (sssetfirst nil (ssadd (entlast)))
       )
   )
   (princ)
)

[VVA]

Try the command PL-CSE from one of my project

;; Pltools Chain Select Entities
(defun C:PL-CSE ( / ss en fuzz obj pt pt1 len dst ptother what lst *error* *pl:IsRus*)
(vl-load-com)
(setq *pl:IsRus* (= (getvar "DWGCODEPAGE") "ANSI_1251"))
(defun *error* (msg)(princ msg)
  (vla-EndUndoMark(vla-get-ActiveDocument (vlax-get-acad-object)))(princ))
(vla-StartUndoMark(vla-get-ActiveDocument (vlax-get-acad-object))) 
(setvar "cmdecho" 0)
 
(if (and (setq en (entsel (if *pl:IsRus* "\nВыбрать линию в цепи :""\nTo choose a line in a chain :")))
         (wcmatch (cdr(assoc 0 (entget (car en)))) "ARC,LINE,*POLYLINE")
         (setq obj (vlax-ename->vla-object (car en)))
         (cond ((=(vla-get-ObjectName obj) "AcDb3dPolyline")
                (princ (if *pl:IsRus* "\n3d Полилиния. " "\n3d Polyline. ")) nil)
               ((and (=(vla-get-ObjectName obj) "AcDbLine")
                     (not(equal (last(cdr(assoc 10 (entget(car en)))))
                            (last(cdr(assoc 11 (entget(car en)))))
                            1e-9
                            )
                         )
                     )
                (princ (if *pl:IsRus* "\nОтрезок. Разные координаты Z. " "\nLine. Different co-ordinates Z. ")) nil)
               ((and (=(vla-get-ObjectName obj) "AcDb2dPolyline")
                    (member (vla-get-Type obj) '(1 2 3)))
                (princ (if *pl:IsRus* "\n2d сглаженная полилиния. " "2d the smoothed polyline")) nil)
               (t t)
               )
         )
(progn
(setq pt1 (trans (cadr en) 1 0))  
(setq pt1 (vlax-curve-getclosestpointto obj pt1))
(setq len (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj)))
(setq dst (vlax-curve-getDistAtPoint obj pt1))
(if (<= dst (- len dst))
  (setq pt (vlax-curve-getStartPoint obj) ptother (vlax-curve-getEndPoint obj))
  (setq pt (vlax-curve-getEndPoint obj) ptother (vlax-curve-getStartPoint obj))
  )
 (_vxgrdraw (trans pt 0 1) -1)
(mip_grdraw (trans pt1 0 1)
 (angle (trans pt1 0 1)(trans pt 0 1)) 1)
(initget "Ближайшая Противоположная Обе Nearest Opposite Both _Nearest Opposite Both Nearest Opposite Both")
(princ (if *pl:IsRus*
  "\nСтроить цепочку от ближайшей точки [Ближайшая/Противоположная/Обе] <Обе>:"
  "\nTo build a chain from the nearest point [Nearest/Opposite/Both] <Both>:"
  )
)
(setq what (getkword))
(cond ((= what "Opposite")
       (setq pt (list ptother))
       (vl-cmdf "_.redrawall")
       (_vxgrdraw (trans ptother 0 1) -1)
       (mip_grdraw (trans pt1 0 1)
 (angle (trans pt1 0 1)(trans ptother 0 1)) 1)
       )
      ((= what "Nearest") (setq pt (list pt)))
      (t (setq pt (list pt ptother)))
      )

(if (null *FUZZ*)(setq *FUZZ* 0.0))
(princ (if *pl:IsRus* "\nЗначение допуска < " "\nFuzz distance < "))(princ *FUZZ*)(princ " >: ")
(if (null (setq fuzz  (getdist)))
  (setq fuzz *FUZZ*))
(setq *FUZZ* fuzz)
(vl-cmdf "_.redrawall")
(setq ss nil ss (ssadd (car en)))
      
(setq lst (ChainSelectFromAny1 pt obj (+ fuzz 1e-6) nil))
(foreach item lst
     (ssadd (vlax-vla-object->ename item) ss)
   )
 (mip:mark)
 (vl-catch-all-apply '(lambda()
   (setq pda (getvar "peditaccept"))
   (setvar "peditaccept" 1)
   (command "_pedit" "_M" ss "" "_j" "_j" "_b" fuzz "")
   (setvar "peditaccept" pda))
   )
  (setq lst (vl-remove-if 'vlax-erased-p lst))
 (if (setq ss nil ss (mip:get-last-ss))
   (progn
     (if lst
       (foreach item lst (ssadd (vlax-vla-object->ename item) ss)))
     (sssetfirst ss ss)))
 (setq ss nil)
 )
  (princ  (if *pl:IsRus* " Невожможно преобразовать в полилинию" "It is impossible to transform to a polyline"))
  )
(vla-EndUndoMark(vla-get-ActiveDocument(vlax-get-acad-object)))
(vl-cmdf "_.redrawall") 
 (princ)
 )
;;;-----------------------------------------------------------------------------------
;;;-----------------------------------------------------------------------------------
;;;  KB:mark
;;;* Mark data base to allow KB:catch.
;;;*http://www.theswamp.org/index.php?topic=15863.0
(defun mip:mark (/ val)
  (setq val (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (if (setq *mip:mark (entlast))
     nil
     (progn (entmake '((0 . "point") (10 0.0 0.0 0.0)))
            (setq *mip:mark (entlast))
            (entdel *mip:mark)
     )
  )
  (setvar "cmdecho" val)
  (princ)
)
;;;-----------------------------------------------------------------------------------
;;;-----------------------------------------------------------------------------------
;;;  KB:catch
;;;* returns selection set of entities since last KB:mark.
;;;*
(defun mip:get-last-ss (/ ss tmp)
  (if *mip:mark
     (progn (setq ss (ssadd))
            (while (setq *mip:mark (entnext *mip:mark)) (ssadd *mip:mark ss))
            (command "._select" ss "")
            (setq tmp ss)
     )
     (alert "*mip:mark not set. \n run (mip:mark) before mip:get-last-ss.")
  )
)
;;* Утилита объединения набора линий в полилинию*
;;* Должно выбирать все (сначала и с конца) найденные примитивы в цепочку)
;;------------------------------------------------
;;Алгорити взят у ChainSelect Fatty
;;http://www.cadforyou.spb.ru/index.php?current_section=section_programs_page
;;Доработан до понимания ARC,PLINE,LINE
;;Для выполнения необходимо указать только точку
;; pt - Список точек для выбранных примитивов в МСК !!!
;; obj - объект
;; fuzz - точность
;; nb - готовый набор или nil
;;Возвращает список vla объектов
(defun ChainSelectFromAny1 ( pt obj fuzz nb / chain_list couple line_lst ln ss cycl line_list )
(vl-load-com)
(setq obj (pl:conv-ent-to-vla  obj))
(if (setq ss (ssget "_I")
         ss nil
  ss (if nb nb (ssget "_X" '((0 . "ARC,LINE,*POLYLINE"))))
   ) ;_ end of setq
 (progn
   (setq line_lst  (mapcar 'vlax-ename->vla-object
                            (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
                    ) ;_ end of mapcar
         chain_list nil
         chain_list (list obj)
   ) ;_ end of setq
   (setq line_lst (vl-remove-if
                     '(lambda (x)
                        (eq "AcDb3dPolyline" (vla-get-objectname x))
                      ) ;_ end of lambda
                     line_lst
                   ) ;_ end of vl-remove-if
   ) ;_ end of setq
    (setq line_lst (vl-remove obj line_lst))
   (setq cycl 0 line_list line_lst)
   (foreach pt_Pattern pt
    (while
       (setq couple
              (vl-remove-if-not
                (function (lambda (x)
                            ;; значение допуска 0.01 можно изменить по ситуации
                            ;; в зависимости от единиц черчения : 
                            (or (equal (vlax-curve-getStartPoint x)
                                       pt_Pattern
                                       fuzz      ;<--- допуск 
                                ) ;_ end of equal
                                (equal (vlax-curve-getEndPoint x)
                                       pt_Pattern
                                       fuzz     ;<--- допуск 
                                ) ;_ end of equal
                            ) ;_ end of or
                          ) ;_ end of lambda
                ) ;_ end of function
                line_list
              ) ;_ end of vl-remove-if-not
       ) ;_ end of setq
      (grtext -1 (strcat "Обработка. Цикл - " (itoa (setq cycl (1+ cycl)))))
      (if couple
          (progn
            (setq chain_list (cons (car couple) chain_list))
            (setq ln (car chain_list))
            (setq line_list (vl-remove ln line_list))
            (setq pt_Pattern (if (equal pt_Pattern (vlax-curve-getStartPoint ln) 1e-6)
                               (vlax-curve-getEndPoint ln)
                               (vlax-curve-getStartPoint ln)
                               )
                  )
          ) ;_ end of progn
        ) ;_ end of if
     )
  )
 ) ;_ end of progn
) ;_ end of if
chain_list
)
(defun mip_grdraw ( ptdraw ang color / pt1 pt2 )
 (setq pt1 (polar ptdraw (+ ang (pl:DTR 135)) (* 0.05 (getvar "VIEWSIZE"))))
 (setq pt2 (polar ptdraw (+ ang (pl:DTR 225)) (* 0.05 (getvar "VIEWSIZE"))))
 (grvecs (list color pt1 ptdraw ptdraw pt2))
 )
(defun _vxgrdraw ( ptdraw color / ang pt11 pt12 pt21 pt22 len )
 (setq len (* 0.03 (getvar "VIEWSIZE"))
      ang 0
      pt11 (polar ptdraw (+ ang (pl:DTR 225)) len)
      pt12 (polar ptdraw (+ ang (pl:DTR 45)) len)
      pt21 (polar ptdraw (+ ang (pl:DTR 315)) len)
      pt22 (polar ptdraw (+ ang (pl:DTR 135)) len))
 (grvecs (list color pt11 pt12 pt21 pt22))
 )
;|=============================================================================
*    Функция преобразования полученного значения в ename
*    Параметры вызова:
*	ent_value	значение, которое надо преобразовать в примитив. Может
*			быть:
*                       -    именем примитива,
*                       -    vla-указателем,
*                       -    меткой,
*                       -    спиком entget,
*                       -    спиком entsel.
*			Если не принадлежит ни одному из указанных типов,
*			возвращается nil
*    Примеры вызова:
(pl:conv-ent-to-ename (entlast))
(pl:conv-ent-to-ename (entget(entlast)))
(pl:conv-ent-to-ename (cdr(assoc 5 (entget(entlast)))))
(pl:conv-ent-to-ename (car(entsel)))
(pl:conv-ent-to-ename (vlax-ename->vla-object (entlast)))
=============================================================================|;
(defun pl:conv-ent-to-ename (ent_value / ret)
 (cond
   ((= (type ent_value) 'vla-object) (vlax-vla-object->ename ent_value))
   ((= (type ent_value) 'ename) ent_value)
   ((and (= (type ent_value) 'list)
         (= (type (setq ret (car ent_value))) 'ename)
         )
    ret
    )
   ((and (= (type ent_value) 'str)(setq ret (handent ent_value))) ret)
   ((= (type ent_value) 'list)(cdr (assoc -1 ent_value)))
   (t nil)
   ) ;_ end of cond
 ) ;_ end of defun

;|=============================================================================
*    Функция преобразования полученного значения в vla-указатель.
*    Параметры вызова:
*	ent_value	значение, которое надо преобразовать в примитив. Может
*			быть:
*                       -    именем примитива,
*                       -    vla-указателем,
*                       -    меткой,
*                       -    спиком entget,
*                       -    спиком entsel.
*			Если не принадлежит ни одному из указанных типов,
*			возвращается nil
*    Примеры вызова:
(pl:conv-ent-to-vla (entlast))
(pl:conv-ent-to-vla (entget(entlast)))
(pl:conv-ent-to-vla (cdr(assoc 5 (entget(entlast)))))
(pl:conv-ent-to-vla (car(entsel)))
(pl:conv-ent-to-vla (vlax-ename->vla-object (entlast)))
=============================================================================|;
(defun pl:conv-ent-to-vla (ent_value / ret)
 (cond
   ((= (type ent_value) 'vla-object) ent_value)
   ((= (type ent_value) 'ename) (vlax-ename->vla-object ent_value))
   ((setq ret (pl:conv-ent-to-ename ent_value))(vlax-ename->vla-object ret))
   (t nil)
   ) ;_ end of cond
 ) ;_ end of defun
;;;Ф-ция переводит градусы в радианы
;;;( pl:DTR a)
(defun pl:DTR (a)(* pi (/ a 180.0)))
;;;---------------------------------------------
;;;Ф-ция переводит радианы в градусы
;;;( R2D a)
(defun pl:RTD (a)(/ (* a 180.0) pi))
(vl-load-com)
(princ "\nType PL-CSE in command line")(princ)

[Lee Mac]

Here is my version of a 'Chain Selection':

 

[color=GREEN];;--------------------=={ Chain Selection }==-----------------;;[/color]
[color=GREEN];;                                                            ;;[/color]
[color=GREEN];;  Prompts the user to select an object and generates a      ;;[/color]
[color=GREEN];;  selection chain of all objects sharing endpoints with     ;;[/color]
[color=GREEN];;  objects in the accumulative selection.                    ;;[/color]
[color=GREEN];;------------------------------------------------------------;;[/color]
[color=GREEN];;  Author: Lee Mac, Copyright © 2012 - www.lee-mac.com       ;;[/color]
[color=GREEN];;------------------------------------------------------------;;[/color]

([color=BLUE]defun[/color] c:cs ( [color=BLUE]/[/color] en fl in l1 l2 s1 s2 sf vl )
   ([color=BLUE]setq[/color] sf
       ([color=BLUE]list[/color]
          '(-4 . [color=MAROON]"<OR"[/color])
              '(0 . [color=MAROON]"LINE,ARC"[/color])
              '(-4 . [color=MAROON]"<AND"[/color])
                  '(0 . [color=MAROON]"LWPOLYLINE,SPLINE"[/color])
                  '(-4 . [color=MAROON]"<NOT"[/color])
                      '(-4 . [color=MAROON]"&="[/color])
                      '(70 . 1)
                  '(-4 . [color=MAROON]"NOT>"[/color])
              '(-4 . [color=MAROON]"AND>"[/color])
              '(-4 . [color=MAROON]"<AND"[/color])
                  '(0 . [color=MAROON]"POLYLINE"[/color])
                  '(-4 . [color=MAROON]"<NOT"[/color])
                      '(-4 . [color=MAROON]"&"[/color])
                      '(70 . 89)
                  '(-4 . [color=MAROON]"NOT>"[/color])
                  '(-4 . [color=MAROON]"AND>"[/color])
              '(-4 . [color=MAROON]"<AND"[/color])
                  '(0 . [color=MAROON]"ELLIPSE"[/color])
                  '(-4 . [color=MAROON]"<OR"[/color])
                      '(-4 . [color=MAROON]"<>"[/color])
                      '(41 . 0.0)
                      '(-4 . [color=MAROON]"<>"[/color])
                       ([color=BLUE]cons[/color] 42 ([color=BLUE]+[/color] [color=BLUE]pi[/color] [color=BLUE]pi[/color]))
                  '(-4 . [color=MAROON]"OR>"[/color])
              '(-4 . [color=MAROON]"AND>"[/color])
          '(-4 . [color=MAROON]"OR>"[/color])
           ([color=BLUE]if[/color] ([color=BLUE]=[/color] 1 ([color=BLUE]getvar[/color] 'cvport))
               ([color=BLUE]cons[/color] 410 ([color=BLUE]getvar[/color] 'ctab))
              '(410 . [color=MAROON]"Model"[/color])
           )
       )
   )
   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] s1 ([color=BLUE]ssget[/color] [color=MAROON]"_X"[/color] sf))
       ([color=BLUE]if[/color] ([color=BLUE]setq[/color] en ([color=BLUE]ssget[/color] [color=MAROON]"_+.:E:S"[/color] sf))
           ([color=BLUE]progn[/color]
               ([color=BLUE]setq[/color] s2 ([color=BLUE]ssadd[/color])
                     en ([color=BLUE]ssname[/color] en 0)
                     l1 ([color=BLUE]list[/color] ([color=BLUE]vlax-curve-getstartpoint[/color] en) ([color=BLUE]vlax-curve-getendpoint[/color] en))
               )
               ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] in ([color=BLUE]sslength[/color] s1))
                   ([color=BLUE]setq[/color] en ([color=BLUE]ssname[/color] s1 ([color=BLUE]setq[/color] in ([color=BLUE]1-[/color] in)))
                         vl ([color=BLUE]cons[/color] ([color=BLUE]list[/color] ([color=BLUE]vlax-curve-getstartpoint[/color] en) ([color=BLUE]vlax-curve-getendpoint[/color] en) en) vl)
                   )
               )
               ([color=BLUE]while[/color]
                   ([color=BLUE]progn[/color]
                       ([color=BLUE]foreach[/color] v vl
                           ([color=BLUE]if[/color] ([color=BLUE]vl-some[/color] '([color=BLUE]lambda[/color] ( p ) ([color=BLUE]or[/color] ([color=BLUE]equal[/color] ([color=BLUE]car[/color] v) p 1e- ([color=BLUE]equal[/color] ([color=BLUE]cadr[/color] v) p 1e-)) l1)
                               ([color=BLUE]setq[/color] s2 ([color=BLUE]ssadd[/color] ([color=BLUE]caddr[/color] v) s2)
                                     l1 ([color=BLUE]vl-list*[/color] ([color=BLUE]car[/color] v) ([color=BLUE]cadr[/color] v) l1)
                                     fl [color=BLUE]t[/color]
                               )
                               ([color=BLUE]setq[/color] l2 ([color=BLUE]cons[/color] v l2))
                           )
                       )
                       fl
                   )
                   ([color=BLUE]setq[/color] vl l2 l2 [color=BLUE]nil[/color] fl [color=BLUE]nil[/color])
               )
           )
       )
       ([color=BLUE]princ[/color] [color=MAROON]"\nNo valid objects found."[/color])
   )
   ([color=BLUE]sssetfirst[/color] [color=BLUE]nil[/color] s2)
   ([color=BLUE]princ[/color])
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

 

Example:

 

[rkent]

Very nice Lee. This is good for selection sets and for verifying that objects to form a closed area, etc. Thanks for your generosity.

[Lee Mac]

Very nice Lee. This is good for selection sets and for verifying that objects to form a closed area, etc. Thanks for your generosity.

 

You're very welcome rkent, I'm pleased that you can make use of it - thank you for your appreciation & gratitude.