Connecting starting and ending vertexes of 3dpolylines in the same vertical plane

[drdownload18]

Is it possible to create lisp code for connecting two 3Dpolylines into one (like ring) by connecting first and last vertex?

 

Ring.dwg

[mhupp]

This is the manual way to do it. selecting two polylines at a time.

 

(defun C:FOO (/ ss p1 p2 p3 p4)
  (vl-load-com)
  (while (and (setq ss (ssget '((0 . "*POLYLINE")))) (= (sslength ss) 2))
    (setq p1 (vlax-curve-getstartpoint (ssname ss 0)))
    (setq p2 (vlax-curve-getendpoint (ssname ss 0)))
    (setq p3 (vlax-curve-getstartpoint (ssname ss 1)))  
    (setq p4 (vlax-curve-getendpoint (ssname ss 1)))
    (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p3)))
    (ssadd (entlast) ss)
    (entmake (list '(0 . "LINE") (cons 10 p2) (cons 11 p4)))
    (ssadd (entlast) ss)
    (command "_.Join" SS "")
  )
)

 

[marko_ribar]

Similar, but little more reliable... Untested though...

 

(defun c:conn23dp-planes ( / *error* tttt vertlst wcs initvalueslst ucsf ti  ss i pls pl vl pll sp1 ep1 sp2 ep2 li1 li2 )

  (defun *error* ( m )
    (if wcs
      (if ucsf
        (while
          (not
            (and
              (equal (getvar (quote ucsxdir)) (car ucsf) 1e-6)
              (equal (getvar (quote ucsydir)) (cadr ucsf) 1e-6)
              (equal (trans (list 0.0 0.0 1.0) 1 0 t) (caddr ucsf) 1e-6)
            )
          )
          (exe (list "_.UCS" "_P"))
        )
      )
    )
    (while (= 8 (logand 8 (getvar (quote undoctl))))
      (if (not (exe (list "_.UNDO" "_E")))
        (if doc
          (vla-endundomark doc)
        )
      )
    )
    (if initvalueslst
      (mapcar (function apply_cadr->car) initvalueslst)
    )
    (foreach fun (list (quote tttt) (quote vl-load) (quote exe) (quote cmdfun) (quote cmderr) (quote catch_cont) (quote apply_cadr->car) (quote ftoa))
      (setq fun nil)
    )
    (if doc
      (vla-regen doc acactiveviewport)
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  (defun tttt ( wcs / sysvarpreset sysvarlst sysvarvals ) ;;; wcs (T/nil) ;;; cad, doc, alo, spc - global variables (Visual Lisp main VLA-OBJECT pointers) ;;; vl-load exe cmdfun cmderr catch_cont apply_cadr->car ftoa - library sub functions common for standard template initialization ;;;

    (defun vl-load nil
      (or cad
        (if vlax-get-acad-object
          (setq cad (vlax-get-acad-object))
          (progn
            (vl-load-com)
            (setq cad (vlax-get-acad-object))
          )
        )
      )
      (or doc (setq doc (vla-get-activedocument cad)))
      (or alo (setq alo (vla-get-activelayout doc)))
      (or spc (setq spc (vla-get-block alo)))
    )

    ;;; sometimes not needed to use/initialize AxiveX Visual Lisp extensions - (comment/uncomment) following line ;;;
    (or (and cad doc alo spc) (vl-load))

    (defun exe ( tokenslist )
      ( (lambda ( tokenslist / ctch )
          (if (vl-catch-all-error-p (setq ctch (cmdfun tokenslist t)))
            (progn
              (cmderr tokenslist)
              (catch_cont ctch)
            )
            (progn
              (while (< 0 (getvar (quote cmdactive)))
                (vl-cmdf "")
              )
              t
            )
          )
        )
        tokenslist
      )
    )

    (defun cmdfun ( tokenslist flag / ctch ) ;;; tokenslist - command parameters list of strings ;;; flag - if "t" specified, upon successful execution returns t, otherwise if "nil" specified, return is always nil no matter what outcome of function execution is - it should be successful anyway if specified tokenslist was hardcoded correctly... ;;;
      (if command-s
        (if flag
          (if (not (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command-s) tokenslist))))
            flag
            ctch
          )
          (if (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command-s) tokenslist)))
            ctch
          )
        )
        (if flag
          (if (not (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function vl-cmdf) tokenslist))))
            flag
            ctch
          )
          (if (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command) tokenslist)))
            ctch
          )
        )
      )
    )

    (defun cmderr ( tokenslist ) ;;; tokenslist - list of tokens representing command syntax at which used (cmdfun) failed with successful execution ;;;
      (prompt (strcat "\ncommand execution failure... error at used command tokenslist : " (vl-prin1-to-string tokenslist)))
    )

    (defun catch_cont ( ctch / gr )
      (prompt "\nleft mouse click to continue or enter to generate catch error - ESC to break...")
      (while
        (and
          (vl-catch-all-error-p (or ctch (setq ctch (vl-catch-all-apply (function /) (list 1 0)))))
          (setq gr (grread))
          (/= (car gr) 3)
          (not (equal gr (list 2 13)))
        )
      )
      (if (vl-catch-all-error-p ctch)
        ctch
      )
    )

    (defun apply_cadr->car ( sysvarvaluepair / ctch )
      (setq ctch (vl-catch-all-apply (function setvar) sysvarvaluepair))
      (if (vl-catch-all-error-p ctch)
        (progn
          (prompt (strcat "\ncatched error on setting system variable : " (vl-prin1-to-string (vl-symbol-name (car sysvarvaluepair))) " with value : " (vl-prin1-to-string (cadr sysvarvaluepair))))
          (catch_cont ctch)
        )
      )
    )

    (defun ftoa ( n / m a s b )
      (if (numberp n)
        (progn
          (setq m (fix ((if (< n 0) - +) n 1e-8)))
          (setq a (abs (- n m)))
          (setq m (itoa m))
          (setq s "")
          (while (and (not (equal a 0.0 1e-6)) (setq b (fix (* a 10.0))))
            (setq s (strcat s (itoa b)))
            (setq a (- (* a 10.0) b))
          )
          (if (= (type n) (quote int))
            m
            (if (= s "")
              m
              (if (and (= m "0") (< n 0))
                (strcat "-" m "." s)
                (strcat m "." s)
              )
            )
          )
        )
      )
    )

    (setq sysvarpreset
      (list
        (list (quote cmdecho) 0)
        (list (quote 3dosmode) 0)
        (list (quote osmode) 0)
        (list (quote unitmode) 0)
        (list (quote cmddia) 0)
        (list (quote ucsvp) 0)
        (list (quote ucsortho) 0)
        (list (quote projmode) 0)
        (list (quote orbitautotarget) 0)
        (list (quote insunits) 0)
        (list (quote hpseparate) 0)
        (list (quote hpgaptol) 0)
        (list (quote halogap) 0)
        (list (quote edgemode) 0)
        (list (quote pickdrag) 0)
        (list (quote qtextmode) 0)
        (list (quote dragsnap) 0)
        (list (quote angdir) 0)
        (list (quote aunits) 0)
        (list (quote limcheck) 0)
        (list (quote gridmode) 0)
        (list (quote nomutt) 0)
        (list (quote apbox) 0)
        (list (quote attdia) 0)
        (list (quote blipmode) 0)
        (list (quote copymode) 0)
        (list (quote circlerad) 0.0)
        (list (quote filletrad) 0.0)
        (list (quote filedia) 1)
        (list (quote autosnap) 1)
        (list (quote objectisolationmode) 1)
        (list (quote highlight) 1)
        (list (quote lispinit) 1)
        (list (quote layerpmode) 1)
        (list (quote fillmode) 1)
        (list (quote dragmodeinterrupt) 1)
        (list (quote dispsilh) 1)
        (list (quote fielddisplay) 1)
        (list (quote deletetool) 1)
        (list (quote delobj) 1)
        (list (quote dblclkedit) 1)
        (list (quote attreq) 1)
        (list (quote explmode) 1)
        (list (quote frameselection) 1)
        (list (quote ltgapselection) 1)
        (list (quote pickfirst) 1)
        (list (quote plinegen) 1)
        (list (quote plinetype) 1)
        (list (quote peditaccept) 1)
        (list (quote solidcheck) 1)
        (list (quote visretain) 1)
        (list (quote regenmode) 1)
        (list (quote celtscale) 1.0)
        (list (quote ltscale) 1.0)
        (list (quote osnapcoord) 2)
        (list (quote grips) 2)
        (list (quote dragmode) 2)
        (list (quote lunits) 2)
        (list (quote pickstyle) 3)
        (list (quote navvcubedisplay) 3)
        (list (quote pickauto) 3)
        (list (quote draworderctl) 3)
        (list (quote expert) 5)
        (list (quote auprec) 6)
        (list (quote luprec) 6)
        (list (quote pickbox) 6)
        (list (quote aperture) 6)
        (list (quote osoptions) 7)
        (list (quote dimzin) 8)
        (list (quote pdmode) 35)
        (list (quote pdsize) -1.5)
        (list (quote celweight) -1)
        (list (quote cecolor) "BYLAYER")
        (list (quote celtype) "ByLayer")
        (list (quote clayer) "0")
      )
    )
    (setq sysvarlst (mapcar (function car) sysvarpreset))
    (setq sysvarvals (mapcar (function cadr) sysvarpreset))
    (setq sysvarvals
      (vl-remove nil
        (mapcar
          (function (lambda ( x )
            (if (getvar x) (nth (vl-position x sysvarlst) sysvarvals))
          ))
          sysvarlst
        )
      )
    )
    (setq sysvarlst
      (vl-remove-if-not
        (function (lambda ( x )
          (getvar x)
        ))
        sysvarlst
      )
    )
    (setq initvalueslst
      (apply (function mapcar)
        (cons (function list)
          (list
            sysvarlst
            (mapcar (function getvar) sysvarlst)
          )
        )
      )
    )
    (apply (function mapcar)
      (cons (function setvar)
        (list
          sysvarlst
          sysvarvals
        )
      )
    )
    (while (= 8 (logand 8 (getvar (quote undoctl))))
      (if (not (exe (list "_.UNDO" "_E")))
        (if doc
          (vla-endundomark doc)
        )
      )
    )
    (if (not (exe (list "_.UNDO" "_M")))
      (if doc
        (vla-startundomark doc)
      )
    )
    (if wcs
      (if (= 0 (getvar (quote worlducs)))
        (progn
          (setq ucsf
            (list
              (getvar (quote ucsxdir))
              (getvar (quote ucsydir))
              (trans (list 0.0 0.0 1.0) 1 0 t)
            )
          )
          (exe (list "_.UCS" "_W"))
        )
      )
    )
    wcs
  )

  (defun vertlst ( poly / n p pl )
    (if (and poly (not (vlax-erased-p poly)))
      (progn
        (setq n (1+ (fix (+ 0.1 (vlax-curve-getendparam poly)))))
        (while (<= 0 (setq n (1- n)))
          (setq p (vlax-curve-getpointatparam poly (float n)))
          (if (not (equal p (car pl) 1e-3))
            (setq pl (cons p pl))
          )
        )
      )
    )
    pl
  )


  (setq wcs (tttt t)) ;;; starting "library" template sub function - initialization ;;;
  (if (setq ss (ssget "_:L" (list (cons 0 "*POLYLINE"))))
    (progn
      (setq ti (car (_vl-times)))
      (repeat (setq i (sslength ss))
        (setq pls (cons (ssname ss (setq i (1- i))) pls))
      )
      (while (setq pl (car pls))
        (setq vl (vertlst pl))
        (exe (list "_.UCS" "_3P" "_non" (car vl) "_non" (cadr vl) "_non" (caddr vl)))
        (setq pll
          (vl-some
            (function (lambda ( x )
              (if
                (vl-every
                  (function (lambda ( y )
                    (equal 0.0 (caddr (trans y 0 1)) 1e-6)
                  ))
                  (vertlst x)
                )
                x
              )
            ))
            (vl-remove pl pls)
          )
        )
        (setq vl nil)
        (setq sp1 (vlax-curve-getstartpoint pl) ep1 (vlax-curve-getendpoint pl))
        (setq sp2 (vlax-curve-getstartpoint pll) ep2 (vlax-curve-getendpoint pll))
        (if (inters sp1 sp2 ep1 ep2)
          (progn
            (setq li1
              (entmakex
                (list
                  (cons 0 "LINE")
                  (cons 10 sp1)
                  (cons 11 ep2)
                )
              )
            )
            (setq li2
              (entmakex
                (list
                  (cons 0 "LINE")
                  (cons 10 sp2)
                  (cons 11 ep1)
                )
              )
            )
          )
          (progn
            (setq li1
              (entmakex
                (list
                  (cons 0 "LINE")
                  (cons 10 sp1)
                  (cons 11 sp2)
                )
              )
            )
            (setq li2
              (entmakex
                (list
                  (cons 0 "LINE")
                  (cons 10 ep1)
                  (cons 11 ep2)
                )
              )
            )
          )
        )
        (exe (list "_.JOIN" (ssadd li1 (ssadd pl (ssadd li2 (ssadd pll)))) ""))
        (exe (list "_.UCS" "_P"))
        (setq pls (vl-remove pl pls) pls (vl-remove pll pls))
      )
      (prompt "\nElapsed time : ") (prompt (ftoa (- (car (_vl-times)) ti))) (prompt " milliseconds...")
      (prompt "\nFor UNDO - type \"UNDO\" - \"Back\" option...")
    )
  )
  (*error* nil)
)

 

HTH.

M.R.

Edited January 26, 2023 by marko_ribar

[drdownload18]

52 minutes ago, mhupp said:

This is the manual way to do it. selecting two polylines at a time.

 

(defun C:FOO (/ ss p1 p2 p3 p4)
  (vl-load-com)
  (while (and (setq ss (ssget '((0 . "*POLYLINE")))) (= (sslength ss) 2))
    (setq p1 (vlax-curve-getstartpoint (ssname ss 0)))
    (setq p2 (vlax-curve-getendpoint (ssname ss 0)))
    (setq p3 (vlax-curve-getstartpoint (ssname ss 1)))  
    (setq p4 (vlax-curve-getendpoint (ssname ss 1)))
    (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p3)))
    (ssadd (entlast) ss)
    (entmake (list '(0 . "LINE") (cons 10 p2) (cons 11 p4)))
    (ssadd (entlast) ss)
    (command "_.Join" SS "")
  )
)

 

Thanks! I only need to join after connecting. It helps

[devitg]

13 minutes ago, drdownload18 said:

Thanks! I only need to join after connecting. It helps

What about if polylines are "invert" so the end to end and start to star will make a self intersecting 3dpolyline 

[drdownload18]

33 minutes ago, marko_ribar said:

Similar, but little more reliable... Untested though...

 

(defun c:conn23dp-planes ( / *error* tttt vertlst wcs initvalueslst ucsf ti  ss i pls pl vl pll sp1 ep1 sp2 ep2 li1 li2 )

  (defun *error* ( m )
    (if wcs
      (if ucsf
        (while
          (not
            (and
              (equal (getvar (quote ucsxdir)) (car ucsf) 1e-6)
              (equal (getvar (quote ucsydir)) (cadr ucsf) 1e-6)
              (equal (trans (list 0.0 0.0 1.0) 1 0 t) (caddr ucsf) 1e-6)
            )
          )
          (exe (list "_.UCS" "_P"))
        )
      )
    )
    (while (= 8 (logand 8 (getvar (quote undoctl))))
      (if (not (exe (list "_.UNDO" "_E")))
        (if doc
          (vla-endundomark doc)
        )
      )
    )
    (if initvalueslst
      (mapcar (function apply_cadr->car) initvalueslst)
    )
    (foreach fun (list (quote tttt) (quote vl-load) (quote exe) (quote cmdfun) (quote cmderr) (quote catch_cont) (quote apply_cadr->car) (quote ftoa))
      (setq fun nil)
    )
    (if doc
      (vla-regen doc acactiveviewport)
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  (defun tttt ( wcs / sysvarpreset sysvarlst sysvarvals ) ;;; wcs (T/nil) ;;; cad, doc, alo, spc - global variables (Visual Lisp main VLA-OBJECT pointers) ;;; vl-load exe cmdfun cmderr catch_cont apply_cadr->car ftoa - library sub functions common for standard template initialization ;;;

    (defun vl-load nil
      (or cad
        (if vlax-get-acad-object
          (setq cad (vlax-get-acad-object))
          (progn
            (vl-load-com)
            (setq cad (vlax-get-acad-object))
          )
        )
      )
      (or doc (setq doc (vla-get-activedocument cad)))
      (or alo (setq alo (vla-get-activelayout doc)))
      (or spc (setq spc (vla-get-block alo)))
    )

    ;;; sometimes not needed to use/initialize AxiveX Visual Lisp extensions - (comment/uncomment) following line ;;;
    (or (and cad doc alo spc) (vl-load))

    (defun exe ( tokenslist )
      ( (lambda ( tokenslist / ctch )
          (if (vl-catch-all-error-p (setq ctch (cmdfun tokenslist t)))
            (progn
              (cmderr tokenslist)
              (catch_cont ctch)
            )
            (progn
              (while (< 0 (getvar (quote cmdactive)))
                (vl-cmdf "")
              )
              t
            )
          )
        )
        tokenslist
      )
    )

    (defun cmdfun ( tokenslist flag / ctch ) ;;; tokenslist - command parameters list of strings ;;; flag - if "t" specified, upon successful execution returns t, otherwise if "nil" specified, return is always nil no matter what outcome of function execution is - it should be successful anyway if specified tokenslist was hardcoded correctly... ;;;
      (if command-s
        (if flag
          (if (not (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command-s) tokenslist))))
            flag
            ctch
          )
          (if (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command-s) tokenslist)))
            ctch
          )
        )
        (if flag
          (if (not (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function vl-cmdf) tokenslist))))
            flag
            ctch
          )
          (if (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command) tokenslist)))
            ctch
          )
        )
      )
    )

    (defun cmderr ( tokenslist ) ;;; tokenslist - list of tokens representing command syntax at which used (cmdfun) failed with successful execution ;;;
      (prompt (strcat "\ncommand execution failure... error at used command tokenslist : " (vl-prin1-to-string tokenslist)))
    )

    (defun catch_cont ( ctch / gr )
      (prompt "\nleft mouse click to continue or enter to generate catch error - ESC to break...")
      (while
        (and
          (vl-catch-all-error-p (or ctch (setq ctch (vl-catch-all-apply (function /) (list 1 0)))))
          (setq gr (grread))
          (/= (car gr) 3)
          (not (equal gr (list 2 13)))
        )
      )
      (if (vl-catch-all-error-p ctch)
        ctch
      )
    )

    (defun apply_cadr->car ( sysvarvaluepair / ctch )
      (setq ctch (vl-catch-all-apply (function setvar) sysvarvaluepair))
      (if (vl-catch-all-error-p ctch)
        (progn
          (prompt (strcat "\ncatched error on setting system variable : " (vl-prin1-to-string (vl-symbol-name (car sysvarvaluepair))) " with value : " (vl-prin1-to-string (cadr sysvarvaluepair))))
          (catch_cont ctch)
        )
      )
    )

    (defun ftoa ( n / m a s b )
      (if (numberp n)
        (progn
          (setq m (fix ((if (< n 0) - +) n 1e-8)))
          (setq a (abs (- n m)))
          (setq m (itoa m))
          (setq s "")
          (while (and (not (equal a 0.0 1e-6)) (setq b (fix (* a 10.0))))
            (setq s (strcat s (itoa b)))
            (setq a (- (* a 10.0) b))
          )
          (if (= (type n) (quote int))
            m
            (if (= s "")
              m
              (if (and (= m "0") (< n 0))
                (strcat "-" m "." s)
                (strcat m "." s)
              )
            )
          )
        )
      )
    )

    (setq sysvarpreset
      (list
        (list (quote cmdecho) 0)
        (list (quote 3dosmode) 0)
        (list (quote osmode) 0)
        (list (quote unitmode) 0)
        (list (quote cmddia) 0)
        (list (quote ucsvp) 0)
        (list (quote ucsortho) 0)
        (list (quote projmode) 0)
        (list (quote orbitautotarget) 0)
        (list (quote insunits) 0)
        (list (quote hpseparate) 0)
        (list (quote hpgaptol) 0)
        (list (quote halogap) 0)
        (list (quote edgemode) 0)
        (list (quote pickdrag) 0)
        (list (quote qtextmode) 0)
        (list (quote dragsnap) 0)
        (list (quote angdir) 0)
        (list (quote aunits) 0)
        (list (quote limcheck) 0)
        (list (quote gridmode) 0)
        (list (quote nomutt) 0)
        (list (quote apbox) 0)
        (list (quote attdia) 0)
        (list (quote blipmode) 0)
        (list (quote copymode) 0)
        (list (quote circlerad) 0.0)
        (list (quote filletrad) 0.0)
        (list (quote filedia) 1)
        (list (quote autosnap) 1)
        (list (quote objectisolationmode) 1)
        (list (quote highlight) 1)
        (list (quote lispinit) 1)
        (list (quote layerpmode) 1)
        (list (quote fillmode) 1)
        (list (quote dragmodeinterrupt) 1)
        (list (quote dispsilh) 1)
        (list (quote fielddisplay) 1)
        (list (quote deletetool) 1)
        (list (quote delobj) 1)
        (list (quote dblclkedit) 1)
        (list (quote attreq) 1)
        (list (quote explmode) 1)
        (list (quote frameselection) 1)
        (list (quote ltgapselection) 1)
        (list (quote pickfirst) 1)
        (list (quote plinegen) 1)
        (list (quote plinetype) 1)
        (list (quote peditaccept) 1)
        (list (quote solidcheck) 1)
        (list (quote visretain) 1)
        (list (quote regenmode) 1)
        (list (quote celtscale) 1.0)
        (list (quote ltscale) 1.0)
        (list (quote osnapcoord) 2)
        (list (quote grips) 2)
        (list (quote dragmode) 2)
        (list (quote lunits) 2)
        (list (quote pickstyle) 3)
        (list (quote navvcubedisplay) 3)
        (list (quote pickauto) 3)
        (list (quote draworderctl) 3)
        (list (quote expert) 5)
        (list (quote auprec) 6)
        (list (quote luprec) 6)
        (list (quote pickbox) 6)
        (list (quote aperture) 6)
        (list (quote osoptions) 7)
        (list (quote dimzin) 8)
        (list (quote pdmode) 35)
        (list (quote pdsize) -1.5)
        (list (quote celweight) -1)
        (list (quote cecolor) "BYLAYER")
        (list (quote celtype) "ByLayer")
        (list (quote clayer) "0")
      )
    )
    (setq sysvarlst (mapcar (function car) sysvarpreset))
    (setq sysvarvals (mapcar (function cadr) sysvarpreset))
    (setq sysvarvals
      (vl-remove nil
        (mapcar
          (function (lambda ( x )
            (if (getvar x) (nth (vl-position x sysvarlst) sysvarvals))
          ))
          sysvarlst
        )
      )
    )
    (setq sysvarlst
      (vl-remove-if-not
        (function (lambda ( x )
          (getvar x)
        ))
        sysvarlst
      )
    )
    (setq initvalueslst
      (apply (function mapcar)
        (cons (function list)
          (list
            sysvarlst
            (mapcar (function getvar) sysvarlst)
          )
        )
      )
    )
    (apply (function mapcar)
      (cons (function setvar)
        (list
          sysvarlst
          sysvarvals
        )
      )
    )
    (while (= 8 (logand 8 (getvar (quote undoctl))))
      (if (not (exe (list "_.UNDO" "_E")))
        (if doc
          (vla-endundomark doc)
        )
      )
    )
    (if (not (exe (list "_.UNDO" "_M")))
      (if doc
        (vla-startundomark doc)
      )
    )
    (if wcs
      (if (= 0 (getvar (quote worlducs)))
        (progn
          (setq ucsf
            (list
              (getvar (quote ucsxdir))
              (getvar (quote ucsydir))
              (trans (list 0.0 0.0 1.0) 1 0 t)
            )
          )
          (exe (list "_.UCS" "_W"))
        )
      )
    )
    wcs
  )

  (defun vertlst ( poly / n p pl )
    (if (and poly (not (vlax-erased-p poly)))
      (progn
        (setq n (1+ (fix (+ 0.1 (vlax-curve-getendparam poly)))))
        (while (<= 0 (setq n (1- n)))
          (setq p (vlax-curve-getpointatparam poly (float n)))
          (if (not (equal p (car pl) 1e-3))
            (setq pl (cons p pl))
          )
        )
      )
    )
    pl
  )


  (setq wcs (tttt t)) ;;; starting "library" template sub function - initialization ;;;
  (if (setq ss (ssget "_:L" (list (cons 0 "*POLYLINE"))))
    (progn
      (setq ti (car (_vl-times)))
      (repeat (setq i (sslength ss))
        (setq pls (cons (ssname ss (setq i (1- i))) pls))
      )
      (while (setq pl (car pls))
        (setq vl (vertlst pl))
        (exe (list "_.UCS" "_3P" "_non" (car vl) "_non" (cadr vl) "_non" (caddr vl)))
        (setq pll
          (vl-some
            (function (lambda ( x )
              (if
                (vl-every
                  (function (lambda ( y )
                    (equal 0.0 (caddr (trans y 0 1)) 1e-6)
                  ))
                  (vertlst x)
                )
                x
              )
            ))
            (vl-remove pl pls)
          )
        )
        (setq vl nil)
        (setq sp1 (vlax-curve-getstartpoint pl) ep1 (vlax-curve-getendpoint pl))
        (setq sp2 (vlax-curve-getstartpoint pll) ep2 (vlax-curve-getendpoint pll))
        (if (inters sp1 sp2 ep1 ep2)
          (progn
            (setq li1
              (entmakex
                (list
                  (cons 0 "LINE")
                  (cons 10 sp1)
                  (cons 11 ep2)
                )
              )
            )
            (setq li2
              (entmakex
                (list
                  (cons 0 "LINE")
                  (cons 10 sp2)
                  (cons 11 ep1)
                )
              )
            )
          )
          (progn
            (setq li1
              (entmakex
                (list
                  (cons 0 "LINE")
                  (cons 10 sp1)
                  (cons 11 sp2)
                )
              )
            )
            (setq li2
              (entmakex
                (list
                  (cons 0 "LINE")
                  (cons 10 ep1)
                  (cons 11 ep2)
                )
              )
            )
          )
        )
        (exe (list "_.JOIN" (ssadd li1 (ssadd pl (ssadd li2 (ssadd pll)))) ""))
        (exe (list "_.UCS" "_P"))
        (setq pls (vl-remove pl pls) pls (vl-remove pll pls))
      )
      (prompt "\nElapsed time : ") (prompt (ftoa (- (car (_vl-times)) ti))) (prompt " milliseconds...")
      (prompt "\nFor UNDO - type \"UNDO\" - \"Back\" option...")
    )
  )
  (*error* nil)
)

 

HTH.

M.R.

Thanks! It works for multiple pairs!  

[marko_ribar]

9 minutes ago, devitg said:

What about if polylines are "invert" so the end to end and start to star will make a self intersecting 3dpolyline 

 

I've accounted for that cases in my version...

Thanks for reply, though...

[drdownload18]

10 minutes ago, devitg said:

What about if polylines are "invert" so the end to end and start to star will make a self intersecting 3dpolyline 

I have always polylines in same direction, but for code it will be good to avoid this.

[devitg]

33 minutes ago, marko_ribar said:

 

I've accounted for that cases in my version...

Thanks for reply, though...

Hy marko, would you , please, show the way you solve such situations. For inverted polys??

 

[marko_ribar]

11 minutes ago, devitg said:

Hy marko, would you , please, show the way you solve such situations. For inverted polys??

 

You have it all there in my posted code...

Look for (inters) function and what follows it...

[devitg]

1 minute ago, marko_ribar said:

You have it all there in my posted code...

Look for (inters) function and what follows it...

Ok, I will see it. 

Thanks.

 

[BIGAL]

A simple way is rather than pick two plines drag a line over and like marko_ribar use intersectwith and compare start and end points to intersect point so if not near say start point swap start and end points. You imply which is start end of the two lines.

 

An example using pick point.

(setq tp1 (entsel "\nSelect left side inner wall near end : "))
	(setq tpp1 (entget (car tp1)))
	(setq pt1 (cdr (assoc 10 tpp1)))      
	(setq pt2 (cdr (assoc 11 tpp1)))      
	(setq pt3 (cadr tp1))             
	(setq d1 (distance pt1 pt3))
	(setq d2 (distance pt2 pt3))
		(if (> d1 d2)
		(progn 
			(setq temp pt1)
			(setq pt1 pt2)
			(setq pt2 temp)
		)
		)