« previous next »
Pages: [1] 2  All |   Go Down

Author Topic: join lines  (Read 3619 times)

0 Members and 1 Guest are viewing this topic.

domenicomaria

  • Swamp Rat
  • Posts: 725
join lines
« on: May 29, 2023, 06:39:44 AM »
. I draw a closed 2d polyline of segments only
  counterclockwise (about 20 segments at least)

. I explode the polyline

. the lines deriving from the exploded polyline have the direction of the points p10 and p11
  coincident with the direction they had when they belonged to the polyline

. I delete about half of these segments
  and I redraw them manually, in the opposite direction to the original polyline,
  so as to have a series of segments, which touch each other,
  and which represent the original polyline,
  but the direction of these segments, sometimes,
  does not agree with the direction of the original polyline

. I select all these lines, extract the pairs of points that define them
  and then I want to change the direction of these segments
  so that they define a shape either clockwise or counterclockwise.

. I can not make it !

. and I don't understand why!

. Can anyone help me ?
Code - Auto/Visual Lisp: [Select]
  1. ;---------
  2. (defun :STRING? (s)   (= (type s) 'STR)   )
  3. ;---------
  4. (defun :INT? (arg)   (= (type arg) 'INT)   )
  5. ;---------
  6. (defun :SS-MAKE-PREVIOUS-EB (x-en / ssa)
  7.    (setq ssa (ssadd))
  8.    (while (setq x-en (if x-en (entnext x-en)   (entnext) ) ) (ssadd x-en ssa) )
  9.    (sssetfirst nil ssa) (ssget "_I")
  10.    (if (> (sslength ssa) 0) ssa nil)
  11. )
  12. ;---------
  13. (defun :3DPOLY-EMK-V-LST (v-lst)
  14.    (entmake
  15.       (append
  16.          '(
  17.             (0 . "POLYLINE") (100 . "AcDbEntity") (100 . "AcDb3dPolyline")
  18.             (66 . 1) (10 0.0 0.0 0.0) (70 . 8) (40 . 0.0) (41 . 0.0) (210 0.0 0.0 1.0)
  19.             (71 . 0) (72 . 0) (73 . 0) (74 . 0) (75 . 0)
  20.          )
  21.          (list (cons 62 (atoi (getvar "cecolor"))))
  22.       )
  23.    )
  24.  
  25.    (foreach   vrtx   v-lst
  26.       (entmake
  27.          (append
  28.             '(   (0 . "VERTEX") (100 . "AcDbEntity") (100 . "AcDbVertex") (100 . "AcDb3dPolylineVertex") )
  29.             (list (cons 10 vrtx) )
  30.             '( (40 . 0.0) (41 . 0.0) (42 . 0.0) (50 . 0.0) (70 . 32) (71 . 0) (72 . 0) (73 . 0) (74 . 0) )
  31.          )
  32.       )
  33.    )
  34.  
  35.    (entmake
  36.       '( (0 . "SEQEND") (100 . "AcDbEntity") )  
  37.    )
  38. )
  39. ;---------
  40. (defun :LWDISPLAY-ON  () (setvar "lwdisplay" 1) )
  41. ;---------
  42. (defun :CELWEIGHT (clw) (setvar "celweight" clw) )
  43. ;---------
  44. (defun :CECOLOR (clr-str)
  45.    (cond
  46.       (   (:INT?    clr-str)   (setvar "cecolor" (itoa clr-str) ) )
  47.       (   (:STRING? clr-str)   (setvar "cecolor" clr-str        ) )
  48.    )
  49. )
  50. ;---------
  51. (defun :SS-BEFORE-EN ( x-en / tmp )
  52.    (if (setq tmp (entnext x-en)) (:SS-BEFORE-EN tmp) x-en)
  53. )
  54. ;---------
  55. (defun :SS-BEFORE-EL (  / tmp x-en)
  56.    (if(setq x-en (entlast) )
  57.       (if (setq tmp (entnext x-en)) (:SS-BEFORE-EN tmp) x-en)
  58.       nil
  59.    )
  60. )
  61. ;---------
  62. (defun LM:SSGET ( msg arg / sel )
  63.     (princ msg)
  64.     (setvar 'nomutt 1)
  65.     (setq sel (vl-catch-all-apply 'ssget arg))
  66.     (setvar 'nomutt 0)
  67.     (if (not (vl-catch-all-error-p sel)) sel)
  68. )
  69.  
  70. ;---------
  71. (defun :GEOM-SEG-LST>POINT-LST-LST (x-seg-lst / kwi next-seg v-lst v-lst-lst x-seg )
  72.    (while (> (length x-seg-lst) 1)
  73.       (setq x-seg (car x-seg-lst)   x-seg-lst (cdr x-seg-lst) )
  74.       (setq v-lst (list (car x-seg) ) )
  75.       (setq kwi t)
  76.       (while kwi
  77.          (if(setq next-seg (vl-member-if '(lambda (i) (equal (cadr x-seg) (car i) 1e-6) ) x-seg-lst) )
  78.             (progn
  79.                (setq v-lst (cons (cadr x-seg) v-lst) )
  80.                (setq x-seg (car next-seg) )
  81.                (setq x-seg-lst (vl-remove x-seg x-seg-lst) )
  82.             )
  83.             (progn
  84.                (setq v-lst (cons (last v-lst) v-lst ) )
  85.                (setq kwi nil)
  86.             )
  87.          )
  88.       )
  89.       (setq v-lst-lst (cons v-lst v-lst-lst) )
  90.    )
  91.    v-lst-lst
  92. )
  93.  
  94. ;---------
  95. (defun :SS>ENTGET-LIST (ss / IND L)
  96.    (setq ind 0 l '())
  97.    (repeat (sslength ss)
  98.       (setq l (cons (entget (ssname ss ind) ) l) )      (setq ind (+ 1 ind) )
  99.    )
  100.    (reverse l)
  101. )
  102.  
  103. ;---------
  104. (defun :DXF (code elist) (cdr (assoc code elist)))
  105.  
  106.  
  107. ;---------
  108. (defun C:JOIN-LINES    (    /
  109.                         eb mif v-lst v-lst-lst x-el x-seg x-seg-lst x-seg-lst-c
  110.                          x-seg-lst-s x-ss x-ss-eg-lst
  111.                      )
  112.    
  113.    
  114.    (and
  115.       (setq x-ss (LM:SSGET "\nselect LINES to JOIN <exit> :" '(((0 . "LINE"))) ) )
  116.       (setq x-ss-eg-lst (:SS>ENTGET-LIST x-ss) )
  117.       (setq x-seg-lst    (mapcar   '(lambda (x-el) (list (:DXF 10 x-el) (:DXF 11 x-el) ) )
  118.                                  x-ss-eg-lst
  119.                         )
  120.       )
  121.      
  122.       (setq x-seg-lst-c x-seg-lst)
  123.       (while (> (length x-seg-lst-c) 1)
  124.          (setq x-seg (car x-seg-lst-c)   x-seg-lst-c (cdr x-seg-lst-c) )
  125.          (setq   mif   (vl-member-if
  126.                         '(lambda (i-seg)
  127.                            (or (equal (car x-seg) (car i-seg) 1e-6) (equal (cadr x-seg) (cadr i-seg) 1e-6) )
  128.                         )
  129.                          x-seg-lst-c
  130.                       )
  131.          )
  132.          (if mif
  133.             (setq mif          (car mif)
  134.                   x-seg-lst    (subst (reverse mif) mif x-seg-lst   )
  135.                   x-seg-lst-c (subst (reverse mif) mif x-seg-lst-c )
  136.             )
  137.          )
  138.       )
  139.    )
  140.      
  141.    (setq v-lst-lst (:GEOM-SEG-LST>POINT-LST-LST x-seg-lst) )
  142.    (vl-cmdf "erase" x-ss "")
  143.    (setq eb (:SS-BEFORE-EL) ) (:CECOLOR 240) (:CELWEIGHT 35) (:LWDISPLAY-ON)
  144.    (mapcar '(lambda (v-lst) (:3DPOLY-EMK-V-LST v-lst) ) v-lst-lst)
  145.    (:SS-MAKE-PREVIOUS-EB eb)
  146. )
  147.  
  148. (defun c:JL () (C:JOIN-LINES) )
  149.  
  150. (princ "\ntype JL ")
Logged

VovKa

  • Water Moccasin
  • Posts: 1632
  • Ukraine
Re: join lines
« Reply #1 on: May 29, 2023, 08:57:55 AM »
is this problem the same as in https://www.theswamp.org/index.php?topic=58251.15 ?
Logged

domenicomaria

  • Swamp Rat
  • Posts: 725
Re: join lines
« Reply #2 on: May 29, 2023, 09:59:43 AM »
Quote from: VovKa on May 29, 2023, 08:57:55 AM
is this problem the same as in https://www.theswamp.org/index.php?topic=58251.15 ?
No.
For SHAPE of MESH, there is no problem.

The 2 solutions eliminating the coincident segments in two ways
- checking the coincidence of the midpoints
- comparing segments with segments that have opposite direction
work well.

If sometime doesn't work, it could depend from the analized data.

But normally, MS and MS2, work well.

And there is no problem related to JOIN LINES.

Because the prerequisite for using SHAPE-of-MESH
is that all 3dfaces have an anti-clockwise direction.

While in the case of JOIN LINES,
the assumption is that the segments can have both clockwise and anti-clockwise directions
« Last Edit: May 29, 2023, 10:07:28 AM by domenicomaria »
Logged

kasmo

  • Newt
  • Posts: 28
Re: join lines
« Reply #3 on: May 29, 2023, 11:04:25 AM »
Try joining the lines again, then (command "_pedit" entityname "_r" "") to put the segments all into one direction.

Logged

domenicomaria

  • Swamp Rat
  • Posts: 725
Re: join lines
« Reply #4 on: May 29, 2023, 11:06:34 AM »
Quote from: kasmo on May 29, 2023, 11:04:25 AM
Try joining the lines again, then (command "_pedit" entityname "_r" "") to put the segments all into one direction.

 :-)

No. I want solve without any acad command !
Logged

ribarm

  • Gator
  • Posts: 3287
  • Marko Ribar, architect
Re: join lines
« Reply #5 on: May 29, 2023, 11:22:12 AM »
Can you entmod lines that don't reside in correct orientation CW/CCW and then join them?
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

VovKa

  • Water Moccasin
  • Posts: 1632
  • Ukraine
Re: join lines
« Reply #6 on: May 29, 2023, 11:23:16 AM »
i have this
it is not optimized for lines
accepts segments on any length
Code: [Select]
(defun vk_MergeSegments (Segments / PolyLine PolyLines AdjSegment Fuzz _Find)
  (defun _Find (Point)
    (vl-some (function
       (lambda (Segment)
(cond ((equal (car Segment) Point Fuzz) (setq Segments (vl-remove Segment Segments)) Segment)
       ((equal (last Segment) Point Fuzz) (setq Segments (vl-remove Segment Segments)) (reverse Segment))
)
       )
     )
     Segments
    )
  )
  (setq Fuzz 1e-8)
  (setq Segments (vl-sort Segments (function (lambda (e1 e2) (< (caar e1) (caar e2)))))
PolyLine (car Segments)
Segments (cdr Segments)
  )
  (while Segments
    (if (or (setq AdjSegment (_Find (car PolyLine)))
    (and (setq AdjSegment (_Find (last PolyLine))) (setq PolyLine (reverse PolyLine)))
)
      (setq PolyLine (append (reverse (cdr AdjSegment)) PolyLine))
      (setq PolyLines (cons PolyLine PolyLines)
    PolyLine  (car Segments)
    Segments  (cdr Segments)
      )
    )
  )
  (cons PolyLine PolyLines)
)
Logged

domenicomaria

  • Swamp Rat
  • Posts: 725
Re: join lines
« Reply #7 on: May 29, 2023, 11:31:58 AM »
Thank you VovKa ...

... in the meantime I solved it too

and it also works with various segment groups

I will study your code, because what you do is always interesting !

if you want to do some tests, use the attached dwg

thanks

bye




Code - Auto/Visual Lisp: [Select]
  1. ;---------
  2. (defun :STRING? (s)   (= (type s) 'STR)   )
  3. ;---------
  4. (defun :INT? (arg)   (= (type arg) 'INT)   )
  5. ;---------
  6. (defun :SS-MAKE-PREVIOUS-EB (x-en / ssa)
  7.    (setq ssa (ssadd))
  8.    (while (setq x-en (if x-en (entnext x-en)   (entnext) ) ) (ssadd x-en ssa) )
  9.    (sssetfirst nil ssa) (ssget "_I")
  10.    (if (> (sslength ssa) 0) ssa nil)
  11. )
  12. ;---------
  13. (defun :3DPOLY-EMK-V-LST (v-lst)
  14.    (entmake
  15.       (append
  16.          '(
  17.             (0 . "POLYLINE") (100 . "AcDbEntity") (100 . "AcDb3dPolyline")
  18.             (66 . 1) (10 0.0 0.0 0.0) (70 . 8) (40 . 0.0) (41 . 0.0) (210 0.0 0.0 1.0)
  19.             (71 . 0) (72 . 0) (73 . 0) (74 . 0) (75 . 0)
  20.          )
  21.          (list (cons 62 (atoi (getvar "cecolor"))))
  22.       )
  23.    )
  24.  
  25.    (foreach   vrtx   v-lst
  26.       (entmake
  27.          (append
  28.             '(   (0 . "VERTEX") (100 . "AcDbEntity") (100 . "AcDbVertex") (100 . "AcDb3dPolylineVertex") )
  29.             (list (cons 10 vrtx) )
  30.             '( (40 . 0.0) (41 . 0.0) (42 . 0.0) (50 . 0.0) (70 . 32) (71 . 0) (72 . 0) (73 . 0) (74 . 0) )
  31.          )
  32.       )
  33.    )
  34.  
  35.    (entmake
  36.       '( (0 . "SEQEND") (100 . "AcDbEntity") )  
  37.    )
  38. )
  39. ;---------
  40. (defun :LWDISPLAY-ON  () (setvar "lwdisplay" 1) )
  41. ;---------
  42. (defun :CELWEIGHT (clw) (setvar "celweight" clw) )
  43. ;---------
  44. (defun :CECOLOR (clr-str)
  45.    (cond
  46.       (   (:INT?    clr-str)   (setvar "cecolor" (itoa clr-str) ) )
  47.       (   (:STRING? clr-str)   (setvar "cecolor" clr-str        ) )
  48.    )
  49. )
  50. ;---------
  51. (defun :SS-BEFORE-EN ( x-en / tmp )
  52.    (if (setq tmp (entnext x-en)) (:SS-BEFORE-EN tmp) x-en)
  53. )
  54. ;---------
  55. (defun :SS-BEFORE-EL (  / tmp x-en)
  56.    (if(setq x-en (entlast) )
  57.       (if (setq tmp (entnext x-en)) (:SS-BEFORE-EN tmp) x-en)
  58.       nil
  59.    )
  60. )
  61. ;---------
  62. (defun LM:SSGET ( msg arg / sel )
  63.     (princ msg)
  64.     (setvar 'nomutt 1)
  65.     (setq sel (vl-catch-all-apply 'ssget arg))
  66.     (setvar 'nomutt 0)
  67.     (if (not (vl-catch-all-error-p sel)) sel)
  68. )
  69.  
  70. ;---------
  71. (defun :SS>ENTGET-LIST (ss / IND L)
  72.    (setq ind 0 l '())
  73.    (repeat (sslength ss)
  74.       (setq l (cons (entget (ssname ss ind) ) l) )      (setq ind (+ 1 ind) )
  75.    )
  76.    (reverse l)
  77. )
  78.  
  79. ;---------
  80. (defun :DXF (code elist) (cdr (assoc code elist)))
  81.  
  82.  
  83. ;---------
  84. (defun C:JOIN-LINES  (   /
  85.                         eb mif new-seg-lst new-seg-lst-lst x-el x-seg x-seg-lst x-ss x-ss-eg-lst
  86.                      )
  87.      (and
  88.       (setq x-ss (LM:SSGET "\nselect LINES to JOIN <exit> :" '(((0 . "LINE"))) ) )
  89.       (setq x-ss-eg-lst (:SS>ENTGET-LIST x-ss) )
  90.       (setq x-seg-lst   (mapcar '(lambda (x-el) (list (:DXF 10 x-el) (:DXF 11 x-el) ) ) x-ss-eg-lst))
  91.      
  92.       (setq x-seg       (car x-seg-lst)
  93.             x-seg-lst   (cdr x-seg-lst)
  94.             new-seg-lst-lst '()
  95.             new-seg-lst (list x-seg)
  96.       )
  97.      
  98.       (while x-seg-lst
  99.          (setq   mif (car   (vl-member-if
  100.                            '(lambda   (i-seg)
  101.                                (vl-member-if  '(lambda (i-pt) (equal (cadr x-seg) i-pt 1e-6) )  i-seg )
  102.                             )
  103.                             x-seg-lst
  104.                         )
  105.                    )
  106.          )
  107.          
  108.          (cond
  109.             (  (and mif (equal (cadr x-seg) (car mif) 1e-6) )
  110.                (setq new-seg-lst (append new-seg-lst (list mif) )
  111.                      x-seg mif
  112.                      x-seg-lst (vl-remove mif x-seg-lst)
  113.                )
  114.             )
  115.             (  (and mif (equal (cadr x-seg) (cadr mif) 1e-6) )
  116.                (setq new-seg-lst (append new-seg-lst (list (reverse mif) ) )
  117.                      x-seg (reverse mif)
  118.                      x-seg-lst (vl-remove mif x-seg-lst)
  119.                )
  120.             )
  121.             (  (not mif)
  122.                (setq new-seg-lst-lst (cons new-seg-lst new-seg-lst-lst)
  123.                      x-seg           (car x-seg-lst)
  124.                      new-seg-lst     (list x-seg)
  125.                      x-seg-lst       (cdr x-seg-lst)
  126.                )
  127.             )
  128.          )
  129.       )
  130.     )
  131.    
  132.    (if new-seg-lst (setq new-seg-lst-lst (cons new-seg-lst new-seg-lst-lst) ) )
  133.    
  134.    (vl-cmdf "erase" x-ss "")
  135.    (setq eb (:SS-BEFORE-EL) ) (:CECOLOR 240) (:CELWEIGHT 35) (:LWDISPLAY-ON)
  136.    (foreach i new-seg-lst-lst
  137.       (:3DPOLY-EMK-V-LST (append (mapcar 'car i) (list (last (last i) ) ) ) )
  138.    )
  139.  
  140.    (:SS-MAKE-PREVIOUS-EB eb)
  141. )
  142.  
  143. (defun c:JL () (C:JOIN-LINES) )
  144.  
  145. (princ "\ntype JL ")
Logged

domenicomaria

  • Swamp Rat
  • Posts: 725
Re: join lines
« Reply #8 on: May 29, 2023, 11:44:33 AM »
Quote from: ribarm on May 29, 2023, 11:22:12 AM
Can you entmod lines that don't reside in correct orientation CW/CCW and then join them?

I don't know which is the correct direction (CW/CCW) ...
the segments themselves do not have a CW/CCW direction ...

... the problem is only to join segments that touch each other,
and that have to be put in order

... reversing those that touch either both
at point p10 or both at point p11 ...

the sequence must be    p10 p11,   p10 p11,   p10 p11   ...

They must be consecutive segments ...

I haven't tested vovka's code yet, but I'm sure it works...

my code works and also works with segment groups that define more shapes ...

if you open the attached dwg there are 4 shapes,
made up of often oppositely oriented segments ...

with one command, all segments are all merged
« Last Edit: May 29, 2023, 11:51:47 AM by domenicomaria »
Logged

ribarm

  • Gator
  • Posts: 3287
  • Marko Ribar, architect
Re: join lines
« Reply #9 on: May 29, 2023, 01:15:46 PM »
Quote from: ribarm on May 29, 2023, 11:22:12 AM
Can you entmod lines that don't reside in correct orientation CW/CCW and then join them?

I suppose you exploded already connected segments and get mixed CW/CCW lines... Is that true, or you always get what you don't need to do - already correct p10 p11, p10 p11 ...
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

kasmo

  • Newt
  • Posts: 28
Re: join lines
« Reply #10 on: May 29, 2023, 01:27:08 PM »
Quote from: domenicomaria on May 29, 2023, 11:06:34 AM
Quote from: kasmo on May 29, 2023, 11:04:25 AM
Try joining the lines again, then (command "_pedit" entityname "_r" "") to put the segments all into one direction.

 :-)

No. I want solve without any acad command !

ahem..  :wink:

Code - Auto/Visual Lisp: [Select]
  1. ...
  2. (vl-cmdf "erase" x-ss "")
  3. ...
  4.  
Logged

ribarm

  • Gator
  • Posts: 3287
  • Marko Ribar, architect
Re: join lines
« Reply #11 on: May 29, 2023, 01:39:50 PM »
I've zipped something connected with "word" "chain" and searched my library...
Perhaps it'll help you - I forgot what I used them for...

HTH.
M.R.
« Last Edit: May 29, 2023, 04:30:41 PM by ribarm »
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

domenicomaria

  • Swamp Rat
  • Posts: 725
Re: join lines
« Reply #12 on: May 29, 2023, 01:44:42 PM »
@kasmo

I want to solve this math, logic and geometry problem:

given a set of touching segments,
some oriented counterclockwise and some clockwise,
which define a shape,

extract the ordered list of points to redraw the form ...

and this without using acad commands.

Then, to make a test,
you have to erase and redraw ...
... in acad !
Logged

domenicomaria

  • Swamp Rat
  • Posts: 725
Re: join lines
« Reply #13 on: May 29, 2023, 01:50:45 PM »
@MR
Thanks Marko

I had a look at your code
which seemed quite complex to me...
 ...
 my problem (which I fixed) it's much simpler ...
 ...
 Anyway, I'll study your LISP file

 Thank you

 ciao
« Last Edit: May 30, 2023, 01:02:09 PM by domenicomaria »
Logged

kasmo

  • Newt
  • Posts: 28
Re: join lines
« Reply #14 on: May 29, 2023, 01:51:25 PM »
Quote from: domenicomaria on May 29, 2023, 01:44:42 PM
@kasmo

I want to solve this math, logic and geometry problem:

given a set of touching segments,
some oriented counterclockwise and some clockwise,
which define a shape,

extract the ordered list of points to redraw the form ...

and this without using acad commands.

Then, to make a test,
you have to erase and redraw ...
... in acad !

But why?
Wouldn't this basically achieve the same thing?

Code - Auto/Visual Lisp: [Select]
  1. (defun c:foo ( / ss )
  2.   (if (setq ss (ssget '((0 . "line"))))
  3.     (command "_.pedit" "_m" ss "" "_y" "_j" "1e-6" "_r" "")
  4.   )
  5. )
  6.  
Logged
Pages: [1] 2  All |   Go Up
« previous next »