TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: ribarm on April 03, 2020, 01:37:38 PM

Title: JOIN-BUG
Post by: ribarm on April 03, 2020, 01:37:38 PM
Hi, I am experiencing a bug with JOIN command in AutoCAD 2018... In BricsCAD it works as desired...

When trying to join these 2 lines - JOIN should convert them to 3DPOLYLINE and not LWPOLYLINE - it's 3D...

Any thoughts about this issue...

M.R.
Title: Re: JOIN-BUG
Post by: ribarm on April 03, 2020, 09:44:21 PM
I did this quick fix... But I am not 100% sure is it bulletproof... To me from my testings it seems fine...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:joinlsp ( / *error* cs adoc qaf ss ssli i li lil l1 lil1 lil1l s el sp )
  2.  
  3.  
  4.   (defun *error* ( m )
  5.     (if qaf (setvar 'qaflags qaf))
  6.     (if adoc (vla-endundomark adoc))
  7.     (if m (prompt m))
  8.     (princ)
  9.   )
  10.  
  11.   (defun cs ( s1 en / df ex fl fz in l1 l2 s2 sf vl )
  12.  
  13.     (vl-load-com)
  14.  
  15.     (setq fz 1e-6) ;; Point comparison tolerance
  16.  
  17.     (if s1
  18.       (if en
  19.         (progn
  20.           (setq s2 (ssadd)
  21.             l1 (list (vlax-curve-getstartpoint en) (vlax-curve-getendpoint en))
  22.           )
  23.           (repeat (setq in (sslength s1))
  24.             (setq en (ssname s1 (setq in (1- in)))
  25.               vl (cons (list (vlax-curve-getstartpoint en) (vlax-curve-getendpoint en) en) vl)
  26.             )
  27.           )
  28.           (while
  29.             (progn
  30.               (foreach v vl
  31.                 (if (vl-some '(lambda ( p ) (or (equal (car v) p fz) (equal (cadr v) p fz))) l1)
  32.                   (setq s2 (ssadd (caddr v) s2)
  33.                         l1 (vl-list* (car v) (cadr v) l1)
  34.                         fl t
  35.                   )
  36.                   (setq l2 (cons v l2))
  37.                 )
  38.               )
  39.               fl
  40.             )
  41.             (setq vl l2 l2 nil fl nil)
  42.           )
  43.         )
  44.       )
  45.     )
  46.     (vl-remove-if 'listp (mapcar 'cadr (ssnamex s2)))
  47.   )
  48.  
  49.   (if (= 8 (logand 8 (getvar 'undoctl)))
  50.     (vla-endundomark adoc)
  51.   )
  52.   (setq qaf (getvar 'qaflags))
  53.   (setvar 'qaflags 1)
  54.   (if (setq ss (ssget "_:L"))
  55.     (progn
  56.       (setq ssli (ssget "_P" '((0 . "LINE,ARC,*POLYLINE,SPLINE,ELLIPSE,HELIX"))))
  57.       (repeat (setq i (sslength ssli))
  58.         (setq li (ssname ssli (setq i (1- i))))
  59.         (setq lil (cons li lil))
  60.       )
  61.       (while (setq l1 (car lil))
  62.         (setq lil1 (cs ssli l1))
  63.         (setq lil (vl-remove-if '(lambda ( x ) (vl-position x lil1)) lil))
  64.         (setq lil1l (cons lil1 lil1l))
  65.       )
  66.       (foreach lil1 lil1l
  67.         (setq s (ssadd))
  68.         (foreach li lil1
  69.           (ssadd li s)
  70.           (ssdel li ss)
  71.         )
  72.         (cond
  73.           ( (and (= (sslength s) 2) (vl-every '(lambda ( x ) (= (cdr (assoc 0 (entget x))) "LINE")) (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))))
  74.             (setq el (entlast) sp (ssadd))
  75.             (vl-cmdf "_.PEDIT" "_M" s "")
  76.             (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
  77.             (if (not (eq el (entlast)))
  78.               (while (setq el (entnext el))
  79.                 (ssadd el sp)
  80.               )
  81.             )
  82.             (vl-cmdf "_.JOIN" sp)
  83.             (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
  84.           )
  85.           ( t
  86.             (vl-cmdf "_.JOIN" s)
  87.             (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
  88.           )
  89.         )
  90.       )
  91.       (if (/= (sslength ss) 0)
  92.         (progn
  93.           (vl-cmdf "_.JOIN" ss)
  94.           (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
  95.         )
  96.       )
  97.     )
  98.   )
  99.   (*error* nil)
  100. )
  101.  

Regards, M.R.
Title: Re: JOIN-BUG
Post by: ribarm on April 04, 2020, 08:43:03 AM
It happens that every time I code, I forget about HELIX...
Can someone verify that my code is fine at last...?

M.R.
Title: Re: JOIN-BUG
Post by: DEVITG on April 04, 2020, 09:50:31 AM
It work Ok on my ACAD 2018

Quote
Command: JOINLSP
Select objects: 1 found
Select objects: 1 found, 2 total
Select objects:
_.PEDIT
Select polyline or [Multiple]: _M
Select objects:   2 found
Select objects:
Enter an option [Close/Open/Join/Width/Fit/Spline/Decurve/Ltype gen/Reverse/Undo]:
Command: _.JOIN
Select source object or multiple objects to join at once:   2 found
Select objects to join:
2 objects converted to 1 3D polyline
Command:
Title: Re: JOIN-BUG
Post by: ribarm on April 04, 2020, 10:06:05 AM
It is a little different than BricsCAD... BricsCAD convert always to LWPOLYLINE but correct in 3D... My lisp converts to 3DPOLY if UCS is not aligned with 2 lines, so I don't quite know, I thought PEDIT Multiple Join would be suficcient, but somehow it won't work on my PC CAD 2018... So it converts to 3DPOLY, but as long as it don't disrupt 3D info like JOIN did, I think it's OK...

I autoload it in my acaddoc.lsp, so that now if I want to code for (command "_.JOIN" ss ""), I would firstly (sssetfirst nil ss) and then (c:joinlsp)...
Title: Re: JOIN-BUG
Post by: myloveflyer on April 04, 2020, 10:18:02 AM
Hi,ribarm.Run the program console on the drawing you provided without error prompt, the group code obtained after the merge!My Cad2012.
Code: [Select]
(-1. <Element name: 7ffffb0a250>)
(0. "POLYLINE")
(330. <Element name: 7ffffb089f0>)
(5. "255")
(100. "AcDbEntity")
(67. 0)
(410. "Model")
(8. "CsvToSweep_20200403.19301800")
(100. "AcDb3dPolyline")
(66. 1)
(10 0.0 0.0 0.0)
(70. 8)
(40. 0.0)
(41. 0.0)
(210 0.0 0.0 1.0)
(71. 0)
(72. 0)
(73. 0)
(74. 0)
(75. 0)
Title: Re: JOIN-BUG
Post by: ribarm on April 04, 2020, 10:23:21 AM
This reminds me that instead of PEDIT MULTIPLE JOIN, we can just entmake LWPOLYLINE and remove 2 lines... Not time now, but I'll see it later... Now my dinner...
Title: Re: JOIN-BUG
Post by: myloveflyer on April 04, 2020, 10:27:58 AM
This reminds me that instead of PEDIT MULTIPLE JOIN, we can just entmake LWPOLYLINE and remove 2 lines... Not time now, but I'll see it later... Now my dinner...
Hi,ribarm.
Good idea,I look forward to your modified version!Enjoy your dinner first!
Title: Re: JOIN-BUG
Post by: ribarm on April 04, 2020, 11:34:43 AM
Here is my mod...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:joinlsp ( / *error* unit v^v cs adoc qaf ss ssli i li lil l1 l2 lil1 lil1l s el p1 p2 p3 p4 pp pp1 pp2 ocs )
  2.  
  3.  
  4.   (defun *error* ( m )
  5.     (if qaf (setvar 'qaflags qaf))
  6.     (if adoc (vla-endundomark adoc))
  7.     (if m (prompt m))
  8.     (princ)
  9.   )
  10.  
  11.   (defun unit ( v / d )
  12.     (if (not (equal (setq d (distance '(0.0 0.0 0.0) v)) 0.0 1e-8))
  13.       (mapcar '(lambda ( x ) (/ x d)) v)
  14.     )
  15.   )
  16.  
  17.   (defun v^v ( u v )
  18.     (list
  19.       (- (* (cadr u) (caddr v)) (* (caddr u) (cadr v)))
  20.       (- (* (caddr u) (car v)) (* (car u) (caddr v)))
  21.       (- (* (car u) (cadr v)) (* (cadr u) (car v)))
  22.     )
  23.   )
  24.  
  25.   (defun cs ( s1 en / df ex fl fz in l1 l2 s2 sf vl )
  26.  
  27.     (vl-load-com)
  28.  
  29.     (setq fz 1e-6) ;; Point comparison tolerance
  30.  
  31.     (if s1
  32.       (if en
  33.         (progn
  34.           (setq s2 (ssadd)
  35.             l1 (list (vlax-curve-getstartpoint en) (vlax-curve-getendpoint en))
  36.           )
  37.           (repeat (setq in (sslength s1))
  38.             (setq en (ssname s1 (setq in (1- in)))
  39.               vl (cons (list (vlax-curve-getstartpoint en) (vlax-curve-getendpoint en) en) vl)
  40.             )
  41.           )
  42.           (while
  43.             (progn
  44.               (foreach v vl
  45.                 (if (vl-some '(lambda ( p ) (or (equal (car v) p fz) (equal (cadr v) p fz))) l1)
  46.                   (setq s2 (ssadd (caddr v) s2)
  47.                         l1 (vl-list* (car v) (cadr v) l1)
  48.                         fl t
  49.                   )
  50.                   (setq l2 (cons v l2))
  51.                 )
  52.               )
  53.               fl
  54.             )
  55.             (setq vl l2 l2 nil fl nil)
  56.           )
  57.         )
  58.       )
  59.     )
  60.     (vl-remove-if 'listp (mapcar 'cadr (ssnamex s2)))
  61.   )
  62.  
  63.   (if (= 8 (logand 8 (getvar 'undoctl)))
  64.     (vla-endundomark adoc)
  65.   )
  66.   (setq qaf (getvar 'qaflags))
  67.   (setvar 'qaflags 1)
  68.   (if (setq ss (ssget "_:L"))
  69.     (progn
  70.       (setq ssli (ssget "_P" '((0 . "LINE,ARC,*POLYLINE,SPLINE,ELLIPSE,HELIX"))))
  71.       (repeat (setq i (sslength ssli))
  72.         (setq li (ssname ssli (setq i (1- i))))
  73.         (setq lil (cons li lil))
  74.       )
  75.       (while (setq l1 (car lil))
  76.         (setq lil1 (cs ssli l1))
  77.         (setq lil (vl-remove-if '(lambda ( x ) (vl-position x lil1)) lil))
  78.         (setq lil1l (cons lil1 lil1l))
  79.       )
  80.       (foreach lil1 lil1l
  81.         (setq s (ssadd))
  82.         (foreach li lil1
  83.           (ssadd li s)
  84.           (ssdel li ss)
  85.         )
  86.         (cond
  87.           ( (and (= (sslength s) 2) (vl-every '(lambda ( x ) (= (cdr (assoc 0 (entget x))) "LINE")) (setq el (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))))
  88.             (setq l1 (car el) l2 (cadr el))
  89.             (setq p1 (cdr (assoc 10 (entget l1))) p2 (cdr (assoc 11 (entget l1))))
  90.             (setq p3 (cdr (assoc 10 (entget l2))) p4 (cdr (assoc 11 (entget l2))))
  91.             (cond
  92.               ( (equal p1 p3 1e-6)
  93.                 (setq pp p1 pp1 p2 pp2 p4)
  94.               )
  95.               ( (equal p1 p4 1e-6)
  96.                 (setq pp p1 pp1 p2 pp2 p3)
  97.               )
  98.               ( (equal p2 p3 1e-6)
  99.                 (setq pp p2 pp1 p1 pp2 p4)
  100.               )
  101.               ( (equal p2 p4 1e-6)
  102.                 (setq pp p2 pp1 p1 pp2 p3)
  103.               )
  104.             )
  105.             (if (equal (distance pp1 pp2) (+ (distance pp1 pp) (distance pp pp2)) 1e-14)
  106.               (progn
  107.                 (entupd (cdr (assoc -1 (entmod (subst (cons 10 pp1) (assoc 10 (entget l1)) (entget l1))))))
  108.                 (entupd (cdr (assoc -1 (entmod (subst (cons 11 pp2) (assoc 11 (entget l1)) (entget l1))))))
  109.                 (entdel l2)
  110.               )
  111.               (progn
  112.                 (setq ocs (unit (v^v (mapcar '- pp1 pp) (mapcar '- pp2 pp))))
  113.                 (entmake
  114.                   (list
  115.                     '(0 . "LWPOLYLINE")
  116.                     '(100 . "AcDbEntity")
  117.                     '(100 . "AcDbPolyline")
  118.                     '(90 . 3)
  119.                     (cons 70 (* 128 (getvar 'plinegen)))
  120.                     (cons 38 (caddr (trans pp 0 ocs)))
  121.                     (cons 10 (trans pp1 0 ocs))
  122.                     (cons 10 (trans pp 0 ocs))
  123.                     (cons 10 (trans pp2 0 ocs))
  124.                     (cons 210 ocs)
  125.                     (assoc 8 (entget l1))
  126.                   )
  127.                 )
  128.                 (entdel l1)
  129.                 (entdel l2)
  130.               )
  131.             )
  132.           )
  133.           ( t
  134.             (vl-cmdf "_.JOIN" s)
  135.             (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
  136.           )
  137.         )
  138.       )
  139.       (if (/= (sslength ss) 0)
  140.         (progn
  141.           (vl-cmdf "_.JOIN" ss)
  142.           (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
  143.         )
  144.       )
  145.     )
  146.   )
  147.   (*error* nil)
  148. )
  149.  

HTH., M.R.
Title: Re: JOIN-BUG
Post by: ribarm on April 04, 2020, 01:31:58 PM
Damn, it's not with 2 lines only...

Look in my new attachment...

Now I don't know how to fix it... :(
Title: Re: JOIN-BUG
Post by: ribarm on April 04, 2020, 01:49:29 PM
Only way I see it now is combination of first and last (c:joinlsp)...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:joinlsp ( / *error* unit v^v cs adoc qaf ss ssli i li lil l1 l2 lil1 lil1l s el p1 p2 p3 p4 pp pp1 pp2 ocs sp )
  2.  
  3.  
  4.   (defun *error* ( m )
  5.     (if qaf (setvar 'qaflags qaf))
  6.     (if adoc (vla-endundomark adoc))
  7.     (if m (prompt m))
  8.     (princ)
  9.   )
  10.  
  11.   (defun unit ( v / d )
  12.     (if (not (equal (setq d (distance '(0.0 0.0 0.0) v)) 0.0 1e-8))
  13.       (mapcar '(lambda ( x ) (/ x d)) v)
  14.     )
  15.   )
  16.  
  17.   (defun v^v ( u v )
  18.     (list
  19.       (- (* (cadr u) (caddr v)) (* (caddr u) (cadr v)))
  20.       (- (* (caddr u) (car v)) (* (car u) (caddr v)))
  21.       (- (* (car u) (cadr v)) (* (cadr u) (car v)))
  22.     )
  23.   )
  24.  
  25.   (defun cs ( s1 en / df ex fl fz in l1 l2 s2 sf vl )
  26.  
  27.     (vl-load-com)
  28.  
  29.     (setq fz 1e-6) ;; Point comparison tolerance
  30.  
  31.     (if s1
  32.       (if en
  33.         (progn
  34.           (setq s2 (ssadd)
  35.             l1 (list (vlax-curve-getstartpoint en) (vlax-curve-getendpoint en))
  36.           )
  37.           (repeat (setq in (sslength s1))
  38.             (setq en (ssname s1 (setq in (1- in)))
  39.               vl (cons (list (vlax-curve-getstartpoint en) (vlax-curve-getendpoint en) en) vl)
  40.             )
  41.           )
  42.           (while
  43.             (progn
  44.               (foreach v vl
  45.                 (if (vl-some '(lambda ( p ) (or (equal (car v) p fz) (equal (cadr v) p fz))) l1)
  46.                   (setq s2 (ssadd (caddr v) s2)
  47.                         l1 (vl-list* (car v) (cadr v) l1)
  48.                         fl t
  49.                   )
  50.                   (setq l2 (cons v l2))
  51.                 )
  52.               )
  53.               fl
  54.             )
  55.             (setq vl l2 l2 nil fl nil)
  56.           )
  57.         )
  58.       )
  59.     )
  60.     (vl-remove-if 'listp (mapcar 'cadr (ssnamex s2)))
  61.   )
  62.  
  63.   (if (= 8 (logand 8 (getvar 'undoctl)))
  64.     (vla-endundomark adoc)
  65.   )
  66.   (setq qaf (getvar 'qaflags))
  67.   (setvar 'qaflags 1)
  68.   (if (setq ss (ssget "_:L"))
  69.     (progn
  70.       (setq ssli (ssget "_P" '((0 . "LINE,ARC,*POLYLINE,SPLINE,ELLIPSE,HELIX"))))
  71.       (repeat (setq i (sslength ssli))
  72.         (setq li (ssname ssli (setq i (1- i))))
  73.         (setq lil (cons li lil))
  74.       )
  75.       (while (setq l1 (car lil))
  76.         (setq lil1 (cs ssli l1))
  77.         (setq lil (vl-remove-if '(lambda ( x ) (vl-position x lil1)) lil))
  78.         (setq lil1l (cons lil1 lil1l))
  79.       )
  80.       (foreach lil1 lil1l
  81.         (setq s (ssadd))
  82.         (foreach li lil1
  83.           (ssadd li s)
  84.           (ssdel li ss)
  85.         )
  86.         (cond
  87.           ( (and (= (sslength s) 2) (vl-every '(lambda ( x ) (= (cdr (assoc 0 (entget x))) "LINE")) (setq el (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))))
  88.             (setq l1 (car el) l2 (cadr el))
  89.             (setq p1 (cdr (assoc 10 (entget l1))) p2 (cdr (assoc 11 (entget l1))))
  90.             (setq p3 (cdr (assoc 10 (entget l2))) p4 (cdr (assoc 11 (entget l2))))
  91.             (cond
  92.               ( (equal p1 p3 1e-6)
  93.                 (setq pp p1 pp1 p2 pp2 p4)
  94.               )
  95.               ( (equal p1 p4 1e-6)
  96.                 (setq pp p1 pp1 p2 pp2 p3)
  97.               )
  98.               ( (equal p2 p3 1e-6)
  99.                 (setq pp p2 pp1 p1 pp2 p4)
  100.               )
  101.               ( (equal p2 p4 1e-6)
  102.                 (setq pp p2 pp1 p1 pp2 p3)
  103.               )
  104.             )
  105.             (if (equal (distance pp1 pp2) (+ (distance pp1 pp) (distance pp pp2)) 1e-14)
  106.               (progn
  107.                 (setq el (entlast) sp (ssadd))
  108.                 (vl-cmdf "_.PEDIT" "_M" s "")
  109.                 (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
  110.                 (if (not (eq el (entlast)))
  111.                   (while (setq el (entnext el))
  112.                     (ssadd el sp)
  113.                   )
  114.                 )
  115.                 (vl-cmdf "_.JOIN" sp)
  116.                 (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
  117.               )
  118.               (progn
  119.                 (setq ocs (unit (v^v (mapcar '- pp1 pp) (mapcar '- pp2 pp))))
  120.                 (entmake
  121.                   (list
  122.                     '(0 . "LWPOLYLINE")
  123.                     '(100 . "AcDbEntity")
  124.                     '(100 . "AcDbPolyline")
  125.                     '(90 . 3)
  126.                     (cons 70 (* 128 (getvar 'plinegen)))
  127.                     (cons 38 (caddr (trans pp 0 ocs)))
  128.                     (cons 10 (trans pp1 0 ocs))
  129.                     (cons 10 (trans pp 0 ocs))
  130.                     (cons 10 (trans pp2 0 ocs))
  131.                     (cons 210 ocs)
  132.                     (assoc 8 (entget l1))
  133.                   )
  134.                 )
  135.                 (entdel l1)
  136.                 (entdel l2)
  137.               )
  138.             )
  139.           )
  140.           ( (and (> (sslength s) 2) (vl-every '(lambda ( x ) (= (cdr (assoc 0 (entget x))) "LINE")) (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))))
  141.             (setq el (entlast) sp (ssadd))
  142.             (vl-cmdf "_.PEDIT" "_M" s "")
  143.             (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
  144.             (if (not (eq el (entlast)))
  145.               (while (setq el (entnext el))
  146.                 (ssadd el sp)
  147.               )
  148.             )
  149.             (vl-cmdf "_.JOIN" sp)
  150.             (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
  151.           )
  152.           ( t
  153.             (vl-cmdf "_.JOIN" s)
  154.             (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
  155.           )
  156.         )
  157.       )
  158.       (if (/= (sslength ss) 0)
  159.         (progn
  160.           (vl-cmdf "_.JOIN" ss)
  161.           (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
  162.         )
  163.       )
  164.     )
  165.   )
  166.   (*error* nil)
  167. )
  168.  

M.R.
Sorry if there is still something bad, but it's not by me - it's JOIN command...
Title: Re: JOIN-BUG
Post by: ribarm on April 06, 2020, 01:37:47 AM
My latest mod... You may like it or not, but I think it's now better...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:joinlsp ( / *error* cs adoc qaf ss ssli i li lil l1 l2 lil1 lil1l s el p1 p2 p3 p4 pp pp1 pp2 sp xx ucsf )
  2.  
  3.  
  4.   (defun *error* ( m )
  5.     (if qaf (setvar 'qaflags qaf))
  6.     (if adoc (vla-endundomark adoc))
  7.     (if m (prompt m))
  8.     (princ)
  9.   )
  10.  
  11.   (defun cs ( s1 en / df ex fl fz in l1 l2 s2 sf vl el elpts pts p el1 xx pp ell )
  12.  
  13.     (vl-load-com)
  14.  
  15.     (setq fz 1e-6) ;; Point comparison tolerance
  16.  
  17.     (if s1
  18.       (if en
  19.         (progn
  20.           (setq s2 (ssadd)
  21.             l1 (list (vlax-curve-getstartpoint en) (vlax-curve-getendpoint en))
  22.           )
  23.           (repeat (setq in (sslength s1))
  24.             (setq en (ssname s1 (setq in (1- in)))
  25.               vl (cons (list (vlax-curve-getstartpoint en) (vlax-curve-getendpoint en) en) vl)
  26.             )
  27.           )
  28.           (while
  29.             (progn
  30.               (foreach v vl
  31.                 (if (vl-some '(lambda ( p ) (or (equal (car v) p fz) (equal (cadr v) p fz))) l1)
  32.                   (setq s2 (ssadd (caddr v) s2)
  33.                         l1 (vl-list* (car v) (cadr v) l1)
  34.                         fl t
  35.                   )
  36.                   (setq l2 (cons v l2))
  37.                 )
  38.               )
  39.               fl
  40.             )
  41.             (setq vl l2 l2 nil fl nil)
  42.           )
  43.         )
  44.       )
  45.     )
  46.     (setq el (vl-remove-if 'listp (mapcar 'cadr (ssnamex s2))))
  47.     (setq elpts (mapcar '(lambda ( x ) (list (vlax-curve-getstartpoint x) (vlax-curve-getendpoint x) x)) el))
  48.     (setq p (vl-some '(lambda ( x ) (if (= (length (vl-remove-if '(lambda ( y ) (equal x y fz)) (apply 'append pts))) (1- (length (apply 'append pts)))) x)) (apply 'append pts)))
  49.     (if (null p)
  50.       (setq p (caar elpts))
  51.     )
  52.     (setq el1 (vl-some '(lambda ( x ) (if (vl-member-if '(lambda ( y ) (equal p y fz)) x) x)) elpts))
  53.     (setq elpts (vl-remove el1 elpts))
  54.     (setq elpts (cons el1 elpts))
  55.     (while (setq xx (car elpts))
  56.       (setq ell (cons (caddr xx) ell))
  57.       (setq elpts (vl-remove xx elpts))
  58.       (setq pp (car (vl-remove-if '(lambda ( x ) (equal x p fz)) (reverse (cdr (reverse xx))))))
  59.       (setq el1 (vl-some '(lambda ( x ) (if (vl-member-if '(lambda ( y ) (equal pp y fz)) x) x)) elpts))
  60.       (if el1
  61.         (progn
  62.           (setq elpts (vl-remove el1 elpts))
  63.           (setq elpts (cons el1 elpts))
  64.         )
  65.       )
  66.       (setq p pp)
  67.     )
  68.     ell
  69.   )
  70.  
  71.   (if (= 8 (logand 8 (getvar 'undoctl)))
  72.     (vla-endundomark adoc)
  73.   )
  74.   (setq qaf (getvar 'qaflags))
  75.   (setvar 'qaflags 1)
  76.   (if (setq ss (ssget "_:L"))
  77.     (progn
  78.       (setq ssli (ssget "_P" '((0 . "LINE,ARC,*POLYLINE,SPLINE,ELLIPSE,HELIX"))))
  79.       (repeat (setq i (sslength ssli))
  80.         (setq li (ssname ssli (setq i (1- i))))
  81.         (setq lil (cons li lil))
  82.       )
  83.       (while (setq l1 (car lil))
  84.         (setq lil1 (cs ssli l1))
  85.         (setq lil (vl-remove-if '(lambda ( x ) (vl-position x lil1)) lil))
  86.         (setq lil1l (cons lil1 lil1l))
  87.       )
  88.       (foreach lil1 lil1l
  89.         (setq s (ssadd))
  90.         (foreach li lil1
  91.           (ssadd li s)
  92.           (ssdel li ss)
  93.         )
  94.         (cond
  95.           ( (and (> (sslength s) 1) (vl-every '(lambda ( x ) (= (cdr (assoc 0 (entget x))) "LINE")) (setq el (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))))
  96.             (setq el (mapcar '(lambda ( a b ) (list a b)) el (cdr el)))
  97.             (while (and (setq xx (car el)) (null ucsf))
  98.               (setq l1 (car xx) l2 (cadr xx))
  99.               (setq p1 (cdr (assoc 10 (entget l1))) p2 (cdr (assoc 11 (entget l1))))
  100.               (setq p3 (cdr (assoc 10 (entget l2))) p4 (cdr (assoc 11 (entget l2))))
  101.               (cond
  102.                 ( (equal p1 p3 1e-6)
  103.                   (setq pp p1 pp1 p2 pp2 p4)
  104.                 )
  105.                 ( (equal p1 p4 1e-6)
  106.                   (setq pp p1 pp1 p2 pp2 p3)
  107.                 )
  108.                 ( (equal p2 p3 1e-6)
  109.                   (setq pp p2 pp1 p1 pp2 p4)
  110.                 )
  111.                 ( (equal p2 p4 1e-6)
  112.                   (setq pp p2 pp1 p1 pp2 p3)
  113.                 )
  114.               )
  115.               (if (not (equal (distance pp1 pp2) (+ (distance pp1 pp) (distance pp pp2)) 1e-14))
  116.                 (progn
  117.                   (setq ucsf t)
  118.                   (vl-cmdf "_.UCS" "_3P" "_non" (trans pp1 0 1) "_non" (trans pp 0 1) "_non" (trans pp2 0 1))
  119.                 )
  120.               )
  121.               (setq el (cdr el))
  122.             )
  123.             (setq el (entlast) sp (ssadd))
  124.             (vl-cmdf "_.PEDIT" "_M" s "")
  125.             (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
  126.             (if (not (eq el (entlast)))
  127.               (while (setq el (entnext el))
  128.                 (ssadd el sp)
  129.               )
  130.             )
  131.             (vl-cmdf "_.JOIN" sp)
  132.             (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
  133.             (if ucsf
  134.               (progn
  135.                 (setq ucsf nil)
  136.                 (vl-cmdf "_.UCS" "_P")
  137.               )
  138.             )
  139.           )
  140.           ( (and (> (sslength s) 1) (vl-every '(lambda ( x ) (wcmatch (cdr (assoc 0 (entget x))) "LINE,ARC,*POLYLINE")) (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))))
  141.             (setq el (vl-remove-if-not '(lambda ( x ) (= (cdr (assoc 0 (entget x))) "LINE")) (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))) sp (ssadd))
  142.             (foreach li el
  143.               (ssadd li sp)
  144.               (ssdel li s)
  145.             )
  146.             (setq el (entlast))
  147.             (if (> (sslength sp) 0)
  148.               (progn
  149.                 (vl-cmdf "_.PEDIT" "_M" sp "")
  150.                 (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
  151.                 (if (not (eq el (entlast)))
  152.                   (while (setq el (entnext el))
  153.                     (ssadd el s)
  154.                   )
  155.                 )
  156.               )
  157.             )
  158.             (vl-cmdf "_.JOIN" s)
  159.             (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
  160.           )
  161.           ( t
  162.             (vl-cmdf "_.JOIN" s)
  163.             (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
  164.           )
  165.         )
  166.       )
  167.       (if (/= (sslength ss) 0)
  168.         (progn
  169.           (vl-cmdf "_.JOIN" ss)
  170.           (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
  171.         )
  172.       )
  173.     )
  174.   )
  175.   (*error* nil)
  176. )
  177.  

M.R.
Title: Re: JOIN-BUG
Post by: trogg on April 06, 2020, 03:27:21 AM
Marko,
This was an interesting bug that you found. your last LISP worked for my test on both of your test files.
Good job

~Greg
Title: Re: JOIN-BUG
Post by: ribarm on April 06, 2020, 05:58:23 AM
Marko,
This was an interesting bug that you found. your last LISP worked for my test on both of your test files.
Good job

~Greg

Last LISP can be little shorter... I've just updated it - removed one sufficient (cond) statement...

[EDIT :
BTW... Is this happening with JOIN also in A2019, A2020, A2021?
[/EDIT]
Title: Re: JOIN-BUG
Post by: ribarm on April 06, 2020, 09:57:20 AM
I've changed the code a little I hope lastly...

Can someone answer my question ab A2019, A2020, A2021?

Thanks, M.R.
Title: Re: JOIN-BUG
Post by: Augusto on April 07, 2020, 07:46:05 AM
BTW... Is this happening with JOIN also in A2019, A2020, A2021?

Hello Ribarm!

Using your last modification I had no problems.
The code worked perfectly in autoCAD 2020 x64.


In case you need more tests, I will be available.

Regards, Augusto.
Title: Re: JOIN-BUG
Post by: ribarm on April 07, 2020, 07:48:41 AM
So bug with JOIN command exist still in A2020?
Title: Re: JOIN-BUG
Post by: Augusto on April 07, 2020, 09:04:07 AM
I'm sorry, Ribarm.
I hadn't read the main question in your post.  :oops:

Unfortunately, some items have been converted to AcDbPolyline and not to an AcDb3dPolyline, as desired.

Code: [Select]

(entget(car(entsel)))

((-1 . <Entity name: 28dec660>)
  (0 . "LWPOLYLINE")
  (330 . <Entity name: 28de91f0>)
  (5 . "29E")
  (100 . "AcDbEntity")
  (67 . 0)
  (410 . "Model")
  (8 . "0")
  (100 . "AcDbPolyline")
  (90 . 4)
  (70 . 128)
  (43 . 0.0)
  (38 . 0.0)
  (39 . 0.0)
  (10 30.2876 8.91506)
  (40 . 0.0)
  (41 . 0.0)
  (42 . 0.0)
  (91 . 0)
  (10 30.2876 3.3082)
  (40 . 0.0)
  (41 . 0.0)
  (42 . 0.0)
  (91 . 0)
  (10 37.9326 3.3082)
  (40 . 0.0)
  (41 . 0.0)
  (42 . 0.0)
  (91 . 0)
  (10 37.9326 -0.932329)
  (40 . 0.0)
  (41 . 0.0)
  (42 . 0.0)
  (91 . 0)
  (210 0.0 0.0 1.0)
)

Title: Re: JOIN-BUG
Post by: ribarm on April 07, 2020, 09:21:57 AM
Augusto, when you use JOIN command inside A2020 on my firstly posted DWG, does CAD disrupt geometry - change 3D LINES to 2D and then joins them to LWPOLYLINE, or nothing happens to 3D LINES and conversion is fine -> LWPOLYLINE but in 3D?
Title: Re: JOIN-BUG
Post by: Augusto on April 07, 2020, 04:51:08 PM
Sorry for the delay.
Change 3D LINES to 2D and then joins them to LWPOLYLINE.
Title: Re: JOIN-BUG
Post by: meja on June 11, 2023, 10:39:29 AM
It is amazing code,it can heal break arc , line !!!