Thanks John, I didn't end up getting time to look at doing what I was supposed to. I'm after getting multiple selection added there now but I cannot get the grips to appear correctly. I've tried to put a regen command in there but to no avail.
Here's my edit (I hope you don't mind)
(defun C:QJOIN (/ *error* @Anonymous vars vals e ok ent etyp make ss ss1 selme i ssl layer obsel$ j elev space ans)
;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;* *
;* QJOIN.LSP by John F. Uhden *
;* 2 Village Road *
;* Sea Girt, NJ 08750 *
;* *
;* * * * * * * * * * * * Do not delete this heading! * * * * * * * * * * * *
; Program automatically joins to one selected line, arc, or polyline
; all possible lines, arcs, and polylines on the same layer and elevation.
; v3.0 (10-21-97) added support for R14 LWPOLYLINEs
; v15.00 (04-07-00) for R15
; v15.01 (10-14-02) fixed missing elev for LWPOLYLINE
; v15.02 (08-07-04) added "peditaccept" for R16+
; v16.0 (12-19-19) converted to freeware for Challoner, and modernized
; v16.01 (08-08-22) added prompt if polyline is closed, added sssetfirst
; v16.01_edit (08-08-22) 3dwannab edit to select more than one entity using ssget, tweak sssetfirst to work with change.
(gc)
(prompt "\nQJOIN v16.01 (c)1994-2022, John F. Uhden")
(defun *error* (err)
(@reset)
(if (wcmatch (strcase err) "*CANCEL*,*QUIT*")
(vl-exit-with-error "\r ")
(vl-exit-with-error (strcat "\r*ERROR*: " err))
)
)
(defun @Anonymous ()
(mapcar 'setvar vars vals)
(vla-endundomark *doc*)
(princ)
)
;;-------------------------------------------
;; Initialize drawing and program variables:
;;
(setq *acad* (vlax-get-acad-object))
(setq *doc* (vlax-get *acad* 'ActiveDocument))
(setq vars '("cmdecho" "highlight"))
(setq vals (mapcar 'getvar vars))
(setq obsel$ " Object selected is a(n) "
ok nil
e nil
ss nil
)
(vla-endundomark *doc*)
(vla-startundomark *doc*)
(mapcar 'setvar vars '(0 1))
(setq selme (ssadd)) ; 2022.08.08 3dwannab
(if (setq ss1 (ssget "_:L")) ; 2022.08.08 3dwannab
(progn
;; Added by 3dwannab 2022.08.08
(repeat (setq i (sslength ss1))
(setq e (ssname ss1 (setq i (1- i))))
(setq ent (entget e))
(setq etyp (cdr (assoc 0 ent)))
(setq layer (cdr (assoc 8 ent)))
(setq elev (last (cdr (assoc 10 ent))))
;; end 3dwannb edit
(if (setq space (assoc 67 ent))
(setq space (cdr space))
(setq space 0)
)
(progn
(cond
((= etyp "ARC")
(setq make 1
ok 1
)
)
((= etyp "LINE")
(if (= (last (cdr (assoc 10 ent))) (last (cdr (assoc 11 ent))))
(setq make 1
ok 1
)
(prompt (strcat obsel$ "3DLINE."))
)
)
((= etyp "LWPOLYLINE")
(if (= (boole 1 1 (cdr (assoc 70 ent))) 0)
(setq ok 1
make nil
elev (cdr (assoc 38 ent))
)
(prompt " Polyline is closed.")
)
)
((= etyp "POLYLINE")
(cond
((> (boole 1 8 (cdr (assoc 70 ent))) 0)
(prompt (strcat obsel$ "3DPOLY."))
)
((> (boole 1 16 (cdr (assoc 70 ent))) 0)
(prompt (strcat obsel$ "3DMESH."))
)
(1
(if (= (boole 1 1 (cdr (assoc 70 ent))) 0)
(setq ok 1
make nil
)
(prompt " Polyline is closed.")
)
)
)
)
(1 (prompt (strcat obsel$ etyp ".")))
)
) ;; progn end
(if (and e (= 4 (logand (cdr (assoc 70 (tblsearch "LAYER" layer))) 4)))
(setq ok (prompt (strcat "\nLayer " layer " is LOCKED!")))
) ;; if layer exists and not locked end
(if (and e ok)
(setq ss (ssget "X"
(list
(cons 8 layer)
(cons 67 space)
(cons -4 "<OR")
(cons -4 "<AND")
(cons 0 "LINE")
(cons -4 "*,*,=")
(cons 10 (list 0.0 0.0 elev))
(cons -4 "*,*,=")
(cons 11 (list 0.0 0.0 elev))
(cons -4 "AND>")
(cons -4 "<AND")
(cons 0 "ARC")
(cons -4 "*,*,=")
(cons 10 (list 0.0 0.0 elev))
(cons -4 "AND>")
(cons -4 "<AND")
(cons 0 "POLYLINE")
(cons -4 "<NOT")
(cons -4 "&")
(cons 70 (+ 1 8 16 32 64))
(cons -4 "NOT>")
(cons -4 "*,*,=")
(cons 10 (list 0.0 0.0 elev))
(cons -4 "AND>")
(cons -4 "<AND")
(cons 0 "LWPOLYLINE")
(cons -4 "<NOT")
(cons -4 "&")
(cons 70 1)
(cons -4 "NOT>")
(cons -4 "=")
(cons 38 elev)
(cons -4 "AND>")
(cons -4 "OR>")
)
)
)
(setq ss nil)
) ;; if e and ok end
(if (and ss (> (setq ssl (sslength ss)) 1))
(progn
(mapcar 'setvar vars '(0 0))
(command "_.pedit" e)
;; added "peditaccept" (08-07-04)
(if (and make (/= (getvar "peditaccept") 1)) (command "_Y"))
(command "_J" ss "")
(if (= (getvar "plinegen") 1) (command "_LT" "_ON"))
(command "_X")
(if (setq ss (ssget "P"))
(setq j (- ssl (sslength ss)))
(setq j ssl)
)
(if make (ssadd (entlast) selme)) ; 2022.08.08 3dwannab, to add to the selme selection set.
;; (if (= (getvar "highlight") 0)
;; (prompt "\nIf you saw nothing happen, it's because HIGHLIGHT is OFF.")
;; )
(prompt (strcat "\nJoined " (itoa j) (if (> j 1) " entities." " entity."))) ; 2022.08.08 3dwannab, to correct grammer depending on number of items joined.
)
(if (and e ok) (prompt "\nNo entities found to join."))
) ;; end if ss
) ;; repeat end
(if selme (sssetfirst nil selme)) ; 2022.08.08 3dwannab, to select any created objects after they're created.
(if ss1 (sssetfirst nil ss1)) ; 2022.08.08 3dwannab, so that any selection is not lost.
(command "_.regen")
(princ "\nFinished joining...")
) ;; progn end
) ;; if end
(@reset)
)
(defun c:QJ () (c:QJOIN))
