Ok, getting closer, but now I have an error that creates an extra line closing to two ends. My code is below, this relies on some express tools with some modifications, the modified portions are in my routine below. I have attached an animated screenshot that shows what is going on.
;Written by: Chris Wade
;Permission to use/modify/distribute is granted as long as this notice remains and all changes are documented.
;Version 2.0 - 05/??/2018 - Chris Wade
; - Added support for joining polyLines
(DEFUN C:ja ( / *error* uFlag doc StopLoop SelSet SelLen LoopCT ent PlStWidth PlEdWidth flt)
;;;
;;; MPEDIT.LSP
;;; Copyright © 1999 by Autodesk, Inc.
;;;
;;; Your use of this software is governed by the terms and conditions of the
;;; License Agreement you accepted prior to installation of this software.
;;; Please note that pursuant to the License Agreement for this software,
;;; "[c]opying of this computer program or its documentation except as
;;; permitted by this License is copyright infringement under the laws of
;;; your country. If you copy this computer program without permission of
;;; Autodesk, you are violating the law."
;;;
;;; AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;; AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;; MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. AUTODESK, INC.
;;; DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;; UNINTERRUPTED OR ERROR FREE.
;;;
;;; Use, duplication, or disclosure by the U.S. Government is subject to
;;; restrictions set forth in FAR 52.227-19 (Commercial Computer
;;; Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
;;; (Rights in Technical Data and Computer Software), as applicable.
;;;
;;; ----------------------------------------------------------------
;;; Multiple objects can be selected for the equivalent of the pedit operation
;;; on polylines. Objects that are not polylines will be filtered out of the
;;; selection set.
;;;
(defun ja-mpedit (plines / ss ss2 )
(if plines
(setq plines (acet-ss-filter-current-ucs plines T))
);if
(if plines
(setq plines (car (acet-ss-filter (list plines '(("CURRENTUCS")) T))))
);if
(princ "\n")
(if plines
(setq ss (ja-convert plines));setq
);if
(if (and ss
(> (sslength ss) 0)
plines
);and
(ja-mpedit2 ss "Join") ;after conversion, plines sset is duplicated in ss
(progn
(if (not plines)
(princ "\nNothing selected.")
(princ "\nNo valid objects selected.")
);if
);progn else
);if
ss
);defun c:mpedit
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; mpedit functionality and switch cases based on kword input operation
(defun ja-mpedit2 (plines opt / newWidth ss flt fuz st na ss2 )
; (while (/= opt "eXit")
;(initget 0 "Open Close Join Ltype Decurve Fit Spline Width eXit _Open Close Join Ltype Decurve Fit Spline Width eXit")
; (setq opt (getkword "\nEnter an option [Open/Close/Join/Width/Fit/Spline/Decurve/Ltype gen/eXit] <eXit>: "))
;Changed code below to a cond structure to improve readability R.K.
(if (and opt
(not (equal opt "eXit"))
);and
(acet-undo-begin)
(acet-undo-end)
);if
(cond
((not opt) (setq opt "eXit"))
((= opt "Open") (chgplopen plines)) ;open
((= opt "Close") (chgplclose plines));close
((= opt "Ltype") (chgltgen plines)) ;ltgen
((= opt "Decurve") (chgdecurve plines));decurve
((= opt "Fit") (chgfit plines))
((= opt "Spline") (chgspline plines))
((= opt "Width")
(initget 69)
(setq newWidth (getdist "\nEnter new width for all segments: "))
(chgplwidths plines newWidth)
);width option
((= opt "Join")
(setq flt '((-4 . "<OR")
(0 . "LINE")
(0 . "ARC")
(-4 . "<AND")
(0 . "*POLYLINE")
(-4 . "<NOT") (-4 . "&") (70 . 89) (-4 . "NOT>") ;1 8 16 64
(-4 . "AND>")
(-4 . "OR>")
)
flt (list flt
"\n1 object is invalid for join."
"\n%1 objects are invalid for join."
);list
flt (list flt
(list "LAYERUNLOCKED")
(list "CURRENTUCS")
);list
ss (car (acet-ss-filter (list plines flt T)))
);setq
;(acet-autoload (list "pljoin.lsp" "(acet-pljoin-get-fuzz-and-mode)"))
(acet-autoload (list "pljoin.lsp" "(acet-pljoin ss st fuz)"))
(if ss
(progn
(setvar "highlight" 0)
(setq fuz (ja-acet-pljoin-get-fuzz-and-mode2)
st (cadr fuz)
fuz (car fuz)
na (entlast)
);setq
(acet-pljoin2 ss st fuz)
(setq ss2 (acet-ss-new na))
(setq plines (acet-ss-union (list plines ss2)))
);progn then
(princ "\nNo valid objects to join.")
);if
);cond Join option
);cond close
;);while
);defun mpedit
;;;
;;; PLJOINSUP.LSP
;;; Copyright © 1999 by Autodesk, Inc.
;;;
;;; Your use of this software is governed by the terms and conditions of the
;;; License Agreement you accepted prior to installation of this software.
;;; Please note that pursuant to the License Agreement for this software,
;;; "[c]opying of this computer program or its documentation except as
;;; permitted by this License is copyright infringement under the laws of
;;; your country. If you copy this computer program without permission of
;;; Autodesk, you are violating the law."
;;;
;;; AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;; AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;; MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. AUTODESK, INC.
;;; DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;; UNINTERRUPTED OR ERROR FREE.
;;;
;;; Use, duplication, or disclosure by the U.S. Government is subject to
;;; restrictions set forth in FAR 52.227-19 (Commercial Computer
;;; Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
;;; (Rights in Technical Data and Computer Software), as applicable.
;;;
;;; ----------------------------------------------------------------
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;prompt for fuzz distance and/or pljoinmode setting.
;return list... (fuzz pljoinmode)
;
(defun ja-acet-pljoin-get-fuzz-and-mode2 ( / st fuzz )
(setq st (acet-pljoin-init-mode2))
(princ (acet-str-format "\n Join Type = %1" st))
(if (equal "Both" st)
(princ " (Fillet and Add) ")
);if
(if (not #acet-pljoin-fuzz)
(setq #acet-pljoin-fuzz 0.0)
);if
(if (assoc "OSMODE" (car acet:sysvar-list))
(setvar "OSMODE" (cadr (assoc "OSMODE" (car acet:sysvar-list))))
);if
(setq fuzz "")
(while (equal (type fuzz) 'STR)
(initget "Jointype _Jointype" 4)
(setq fuzz 500.0
;(getdist
; (acet-str-format "\nEnter fuzz distance or [Jointype] <%1>: " (rtos #acet-pljoin-fuzz))
;);getdist
);setq
(cond
((not fuzz)
(setq fuzz #acet-pljoin-fuzz)
);cond #1
((equal "Jointype" fuzz)
(acet-pljoinmode2)
);cond #2
((equal (type fuzz) 'REAL)
(setq #acet-pljoin-fuzz fuzz)
);cond #3
);cond close
);while
(setvar "osmode" 0)
(list #acet-pljoin-fuzz #acet-pljoinmode)
);defun acet-pljoin-get-fuzz-and-mode
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Convert arcs and lines to polylines
;;; ss is retained as a duplicate of the plines selection set because
;;; after conversion, new handles are assigned to what were arcs and lines
(defun ja-convert ( plines / ss count opt )
;(if (> (sslength plines) 0)
; (progn
; (initget 0 "Yes No _Yes No")
; (setq opt (getkword "Convert Lines and Arcs to polylines? [Yes/No] <Yes>: "))
;);progn then
;);if
(if (not opt)
(setq opt "Yes")
)
(if (and (= opt "Yes")
(> (sslength plines) 0)
);and
(progn ;if yes -- convert lines and arcs to polylines
(acet-undo-begin)
(setq ss (ssadd))
(setq count 0)
(while (< count (sslength plines))
(if (or (equal (assoc 0 (entget (ssname plines count))) '(0 . "ARC"))
(equal (assoc 0 (entget (ssname plines count))) '(0 . "LINE"))
);or
(progn
(command "_.pedit" (ssname plines count) "_yes" "_exit")
(ssadd (entlast) ss)
);progn true
(ssadd (ssname plines count) ss)
);if
(setq count (1+ count))
);while
(acet-undo-end)
);progn yes
(progn ;if no -- do not convert
(setq ss plines)
(setq count 0)
(while (< count (sslength ss))
(if (or (equal (assoc 0 (entget (ssname ss count))) '(0 . "ARC"))
(equal (assoc 0 (entget (ssname ss count))) '(0 . "LINE"))
);or
(progn
(ssdel (ssname ss count) ss)
(setq count (1- count))
);progn true
);if
(setq count (1+ count))
);while
);progn no
);if
(if (and ss
(equal (type ss) 'PICKSET)
(equal 0 (sslength ss))
);and
(setq ss nil)
);if
ss
)
(defun ja-work (SelSet)
(if (/= SelSet nil)
(progn
(vla-StartUndoMark doc)
(setq uFlag t)
(setq SelLen (sslength SelSet))
(setq LoopCT 0)
(while (< LoopCT SelLen)
(vl-cmdf "._join" ent SelSet "")
(setq LoopCT (+ LoopCT 1))
)
(vla-EndUndoMark doc)
(setq uFlag nil)
)
)
)
(vl-load-com)
(setq doc (vla-get-ActiveDocument
(vlax-get-acad-object)))
(defun *error* (msg)
(if (and uflag doc) (vla-EndUndoMark doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)
)
(while (= StopLoop nil)
(princ "\nPlease select the objects that you would like to join: ")
(setq SelSet (ssget ":l" '(
(-4 . "<OR")
(0 . "ARC")
(0 . "LINE")
(-4 . "<AND")
(0 . "*POLYLINE")
(-4 . "<NOT") (-4 . "&") (70 . 88) (-4 . "NOT>") ;8 16 64 not a 3dpoly or 3d/pface mesh
(-4 . "AND>")
(0 . "LWPOLYLINE")
(-4 . "OR>")
)
))
(cond
((/= SelSet nil)
(setq SelSet (ja-mpedit SelSet))
(command "-overkill" SelSet "" "p" "" "")
(ja-work SelSet)
)
(T
(setq StopLoop T)
)
)
)
(princ)
);defun c:ja
