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

January 26, 2023

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

Ring.dwg

January 26, 2023

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 "")
  )
)

January 26, 2023

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

January 26, 2023

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

January 26, 2023

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

January 26, 2023

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!

January 26, 2023

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...

January 26, 2023

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.

January 26, 2023

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??

January 26, 2023

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...

January 26, 2023

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.

January 26, 2023

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)
		)
		)

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

Recommended Posts

drdownload18

Link to comment

Share on other sites

mhupp

Link to comment

Share on other sites

marko_ribar

Link to comment

Share on other sites

drdownload18

Link to comment

Share on other sites

devitg

Link to comment

Share on other sites

drdownload18

Link to comment

Share on other sites

marko_ribar

Link to comment

Share on other sites

drdownload18

Link to comment

Share on other sites

devitg

Link to comment

Share on other sites

marko_ribar

Link to comment

Share on other sites

devitg

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity