Code Red > AutoLISP (Vanilla / Visual)
JOIN-BUG
ribarm:
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.
ribarm:
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: ---(defun c:joinlsp ( / *error* cs adoc qaf ss ssli i li lil l1 lil1 lil1l s el sp ) (vl-load-com) (defun *error* ( m ) (if qaf (setvar 'qaflags qaf)) (if adoc (vla-endundomark adoc)) (if m (prompt m)) (princ) ) (defun cs ( s1 en / df ex fl fz in l1 l2 s2 sf vl ) (vl-load-com) (setq fz 1e-6) ;; Point comparison tolerance (if s1 (if en (progn (setq s2 (ssadd) l1 (list (vlax-curve-getstartpoint en) (vlax-curve-getendpoint en)) ) (repeat (setq in (sslength s1)) (setq en (ssname s1 (setq in (1- in))) vl (cons (list (vlax-curve-getstartpoint en) (vlax-curve-getendpoint en) en) vl) ) ) (while (progn (foreach v vl (if (vl-some '(lambda ( p ) (or (equal (car v) p fz) (equal (cadr v) p fz))) l1) (setq s2 (ssadd (caddr v) s2) l1 (vl-list* (car v) (cadr v) l1) fl t ) (setq l2 (cons v l2)) ) ) fl ) (setq vl l2 l2 nil fl nil) ) ) ) ) (vl-remove-if 'listp (mapcar 'cadr (ssnamex s2))) ) (setq adoc (vla-get-activedocument (vlax-get-acad-object))) (if (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark adoc) ) (vla-startundomark adoc) (setq qaf (getvar 'qaflags)) (setvar 'qaflags 1) (if (setq ss (ssget "_:L")) (progn (setq ssli (ssget "_P" '((0 . "LINE,ARC,*POLYLINE,SPLINE,ELLIPSE,HELIX")))) (repeat (setq i (sslength ssli)) (setq li (ssname ssli (setq i (1- i)))) (setq lil (cons li lil)) ) (while (setq l1 (car lil)) (setq lil1 (cs ssli l1)) (setq lil (vl-remove-if '(lambda ( x ) (vl-position x lil1)) lil)) (setq lil1l (cons lil1 lil1l)) ) (foreach lil1 lil1l (setq s (ssadd)) (foreach li lil1 (ssadd li s) (ssdel li ss) ) (cond ( (and (= (sslength s) 2) (vl-every '(lambda ( x ) (= (cdr (assoc 0 (entget x))) "LINE")) (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))) (setq el (entlast) sp (ssadd)) (vl-cmdf "_.PEDIT" "_M" s "") (while (< 0 (getvar 'cmdactive)) (vl-cmdf "")) (if (not (eq el (entlast))) (while (setq el (entnext el)) (ssadd el sp) ) ) (vl-cmdf "_.JOIN" sp) (while (< 0 (getvar 'cmdactive)) (vl-cmdf "")) ) ( t (vl-cmdf "_.JOIN" s) (while (< 0 (getvar 'cmdactive)) (vl-cmdf "")) ) ) ) (if (/= (sslength ss) 0) (progn (vl-cmdf "_.JOIN" ss) (while (< 0 (getvar 'cmdactive)) (vl-cmdf "")) ) ) ) ) (*error* nil))
Regards, M.R.
ribarm:
It happens that every time I code, I forget about HELIX...
Can someone verify that my code is fine at last...?
M.R.
DEVITG:
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:
--- End quote ---
ribarm:
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)...
Navigation
[0] Message Index
[#] Next page
Go to full version