Extend Line inside Closed Polygon

[Abrasive]

Is there a way to draw a Vertical line that terminates on a polyline's edges?

As if I used "Extend" on both sides of the line, but without selecting the Polyline?

So the vertical lines will extend to the first crossing intersection.

The polygon is irregularly shaped, not always square but, the lines to extend are vertical.

I've looked all over can't seem to find anything....

Thanks!

[marko_ribar]

You want to select all lines and all curves and process extensions/trimming of both ends to closest intersection point on curve to perhaps middle of lines?

[marko_ribar]

If answer on my question is yes, then something like this should work - untested though...

 

(defun c:ext-trim-lins2curves ( / *error* tttt ss2lst groupbynum car-sort wcs initvalueslst ucsf ti ss sli scu lil cul mp len sp ep xl ipl p1 p2 lix )

  (defun *error* ( m )
    (if wcs
      (if ucsf
        (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
        (cond
          ( (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil)))
            (setq cad (vlax-get-acad-object))
          )
          ( t
            (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
          (exe (list "_.UCS" "_W"))
          (setq ucsf t)
        )
      )
    )
    wcs
  )

  (defun ss2lst ( ss / i lst )
    (if ss
      (repeat (setq i (sslength ss))
        (setq lst (cons (ssname ss (setq i (1- i))) lst))
      )
    )
  )

  (defun groupbynum ( lst n / sub lll )

    (defun sub ( m n / ll q )
      (cond
        ( (and m (< (length m) n))
          (repeat (- n (length m))
            (setq m (append m (list nil)))
          )
          (setq ll (vl-remove-if-not (function (lambda ( x ) (setq q (if (not q) 0 (1+ q))) (< q n))) m))
          (setq lll (cons ll lll))
          (setq q nil)
          (sub (vl-remove-if (function (lambda ( x ) (setq q (if (not q) 0 (1+ q))) (< q n))) m) n)
        )
        ( m
          (setq ll (vl-remove-if-not (function (lambda ( x ) (setq q (if (not q) 0 (1+ q))) (< q n))) m))
          (setq lll (cons ll lll))
          (setq q nil)
          (sub (vl-remove-if (function (lambda ( x ) (setq q (if (not q) 0 (1+ q))) (< q n))) m) n)
        )
        ( t
          (reverse lll)
        )
      )
    )

    (sub lst n)
  )

  (defun car-sort ( lst cmp / rtn )
    (setq rtn (car lst))
    (foreach itm (cdr lst)
      (if (apply cmp (list itm rtn))
        (setq rtn itm)
      )
    )
    rtn
  )

  (setq wcs (tttt nil)) ;;; starting "library" template sub function - initialization ;;;
  (if (setq ss (ssget (list (cons 0 "*LINE,ELLIPSE,ARC,CRICLE,HELIX"))))
    (progn
      (setq ti (car (_vl-times)))
      (setq sli (ssget "_P" (list (cons 0 "LINE"))))
      (sssetfirst nil ss)
      (setq scu (ssget "_I" (list (cons 0 "~LINE"))))
      (sssetfirst nil sli)
      (setq sli (ssget "_:L-I"))
      (if
        (and
          sli
          (/= 0 (sslength sli))
          scu
          (/= 0 (sslength scu))
        )
        (progn
          (setq lil (ss2lst sli))
          (setq cul (ss2lst scu))
          (foreach li lil
            (setq ipl nil)
            (setq mp (vlax-curve-getpointatparam li (/ (vlax-curve-getendparam li) 2.0)))
            (setq len (vla-get-length (vlax-ename->vla-object li)))
            (setq sp (vlax-curve-getstartpoint li))
            (setq ep (vlax-curve-getendpoint li))
            (setq xl (entmakex (list (cons 0 "XLINE") (cons 10 mp) (cons 11 (mapcar (function /) (mapcar (function -) ep sp) (list len len len))))))
            (foreach cu cul
              (setq ipl (append ipl (vlax-invoke (vlax-ename->vla-object xl) (quote intersectwith) (vlax-ename->vla-object cu) acextendnone)))
            )
            (setq ipl (groupbynum ipl 3))
            (setq p1 (car-sort ipl (function (lambda ( a b ) (< (distance sp a) (distance sp b))))))
            (setq p2 (car-sort ipl (function (lambda ( a b ) (< (distance ep a) (distance ep b))))))
            (setq lix (entget li))
            (cond
              ( (equal p1 p2 1e-6)
                (if (< (distance sp p1) (distance ep p1))
                  (entupd (cdr (assoc -1 (entmod (subst (cons 10 p1) (assoc 10 lix) lix)))))
                  (entupd (cdr (assoc -1 (entmod (subst (cons 11 p1) (assoc 11 lix) lix)))))
                )
              )
              ( t
                (entupd (cdr (assoc -1 (entmod (subst (cons 10 p1) (assoc 10 lix) lix)))))
                (entupd (cdr (assoc -1 (entmod (subst (cons 11 p2) (assoc 11 lix) lix)))))
              )
            )
            (entdel xl)
          )
          (prompt "\nElapsed time : ") (prompt (ftoa (- (car (_vl-times)) ti))) (prompt " milliseconds...")
          (prompt "\nFor UNDO - type \"UNDO\" - \"Back\" option...")
        )
        (prompt "\nEither there are no lines that are on unlocked layer(s) in selection set, or no other curve types in selection set...")
      )
    )
    (prompt "\nEmpty selection set... Better luck next time...")
  )
  (*error* nil)
)

 

Edited March 22 by marko_ribar

[Abrasive]

1 hour ago, marko_ribar said:

You want to select all lines and all curves and process extensions/trimming of both ends to closest intersection point on curve to perhaps middle of lines?

There are no curves. All segments of the polyline are straight. and the Line to extend is straight.

I have a routine that draws lines now, just need a routine to extend them to the closest intersection point.(both sides)

Basically draw a vertical line that extends to the perimeters of the polyline.

Thanks

Edited October 17, 2022 by Abrasive

[BIGAL]

Need a dwg example a before and after.