Help lisp CookieCutter2 v1.2 mod by VVA don't trim polyline 3D

[iSupporter]

Hi All,

I work in 3D polyline. I used lisp CookieCutter2 v1.2 mod by VVA to trim outsite. However, lisp don't work with polyline 3D. I don't want use Flatten.

Help me lisp trim outsite polyline 3D.

Thank you very much.

Suppo

Cut.dwg CookieCutter2 v1.2 mod by VVA.lsp

[BIGAL]

A 2d line etc will trim a 3d line 3dpline you may have to use cookie cutter then go back and trim the 3ds with a second lisp.

 

If your using a pline you can use a method of use the pline as the cut line, offset the pline a small amount use the co-ords to trim using the fence method.

[iSupporter]

44 minutes ago, BIGAL said:

A 2d line etc will trim a 3d line 3dpline you may have to use cookie cutter then go back and trim the 3ds with a second lisp.

  

If your using a pline you can use a method of use the pline as the cut line, offset the pline a small amount use the co-ords to trim using the fence method.

 

I should understand that creating a 3d contour (3d polyline boundaries) to used lisp CC?

[BIGAL]

If you flatten the 3D boundary, Cookie cutter may work. Please test.

[iSupporter]

29 minutes ago, BIGAL said:

If you flatten the 3D boundary, Cookie cutter may work. Please test.

I tested, CC don't work.

Please, help me.

Thank BIGAL.

[BIGAL]

The 3dpoly is not in the cookie cutter code its is still easier to take a 2d boundary and trim.

 

Post a sample dwg. 

[iSupporter]

 

2 hours ago, BIGAL said:

The 3dpoly is not in the cookie cutter code its is still easier to take a 2d boundary and trim.

 

Post a sample dwg. 

I attach file post #1 Cut.dwg. Please, view again.

Thanks.

[iSupporter]

On 3/6/2019 at 4:36 AM, BIGAL said:

The 3dpoly is not in the cookie cutter code its is still easier to take a 2d boundary and trim.

 

Post a sample dwg. 

File sample dwg this attach. Thank BIGAL.

Cut.dwg

[BIGAL]

Ran cookiecutter does not support plines with Z > 0.

 

But typed "extrim" after cookicutter, picked poly, picked outside all done.

 

To me thats a lot of time to try and add to cookie cutter compared to the few seconds to do a second step.

 

[iSupporter]

On 3/9/2019 at 6:48 AM, BIGAL said:

Ran cookiecutter does not support plines with Z > 0.

 

But typed "extrim" after cookicutter, picked poly, picked outside all done.

  

To me thats a lot of time to try and add to cookie cutter compared to the few seconds to do a second step.

 

Thank BIGAL,

I think you haven't tried it on the drawing I attached. Beacause, I typed extrim>pick polyline> picked outside.

No, result.

 

[BIGAL]

But typed "extrim" after cookicutter, picked poly, picked outside all done. It was your dwg taht I tested on ran Cookiecutter 1st. this left the contours so ran extrim it trimmed the contours.

[ramesh patel]

I want apparent trim beetwin two 3dpoly using lips than how to do 

Sample.dwg

[marko_ribar]

Don't have time for testing, but I suppose it should work...

 

(defun c:3dc-trim ( / vl-load *error* cmdfun cmderr catch_cont apply_cadr->car ftoa sysvarpreset sysvarlst sysvarvals initvalueslst ti c1 c2 ip c1x c2x ) ;;; cad, doc, alo, spc - global variables (Visual Lisp main VLA-OBJECT pointers) ;;;

  (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 *error* ( m )
    (if (= 8 (logand 8 (getvar (quote undoctl))))
      (if (not (cmdfun (list "_.UNDO" "_E") t))
        (cmderr 23)
        (if doc
          (vla-endundomark doc)
        )
      )
    )
    (if initvalueslst
      (mapcar (function apply_cadr->car) initvalueslst)
    )
    (if doc
      (vla-regen doc acactiveviewport)
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  (defun cmdfun ( tokenslist flag ) ;;; 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 (vl-catch-all-apply (function command-s) tokenslist)))
          flag
        )
        (apply (function command-s) tokenslist)
      )
      (if flag
        (apply (function vl-cmdf) tokenslist)
        (apply (function command) tokenslist)
      )
    )
  )

  (defun cmderr ( linenum ) ;;; linenum - integer representing line number at which used (cmdfun) failed with success execution ;;;
    (prompt (strcat "\ncommand execution failure... error at line " (itoa linenum) " ..."))
  )

  (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
      )
    )
  )
  (if (= 8 (logand 8 (getvar (quote undoctl))))
    (if (not (cmdfun (list "_.UNDO" "_E") t))
      (cmderr 229)
      (if doc
        (vla-endundomark doc)
      )
    )
  )
  (if (not (cmdfun (list "_.UNDO" "_M") t))
    (cmderr 236)
    (if doc
      (vla-startundomark doc)
    )
  )
  (if
    (and
      (setq c1 (car (entsel "\nPick curve you want to trim with vertical plane of next curve...")))
      (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-curve-getstartpoint) (list c1))))
      (setq c2 (car (entsel "\nPick curve to trim with...")))
      (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-curve-getstartpoint) (list c2))))
    )
    (progn
      (setq ti (car (_vl-times)))
      (if
        (setq ip
          (inters
            (mapcar (function +)
              (list 0.0 0.0)
              (trans (vlax-curve-getstartpoint c1) 0 1)
            )
            (mapcar (function +)
              (list 0.0 0.0)
              (trans (vlax-curve-getendpoint c1) 0 1)
            )
            (mapcar (function +)
              (list 0.0 0.0)
              (trans (vlax-curve-getstartpoint c2) 0 1)
            )
            (mapcar (function +)
              (list 0.0 0.0)
              (trans (vlax-curve-getendpoint c2) 0 1)
            )
          )
        )
        (progn
          (setq ip (vlax-curve-getclosestpointtoprojection c1 ip (trans (list 0.0 0.0 1.0) 1 0 t)))
          (if (not (cmdfun (list "_.BREAK" c1 "_non" (trans ip 0 1) "_non" (trans ip 0 1)) t))
            (cmderr 274)
          )
          (if (not (vlax-erased-p c1))
            (setq c2 (entlast))
            (progn
              (setq c2 (entlast))
              (entdel c2)
              (setq c1 (entlast))
              (entdel c2)
            )
          )
          (if (assoc 62 (setq c1x (entget c1)))
            (setq c1x (subst (cons 62 (1+ (rem (cdr (assoc 62 c1x)) 256))) (assoc 62 c1x)))
            (setq c1x (append c1x (list (cons 62 1))))
          )
          (if (assoc 62 (setq c2x (entget c2)))
            (setq c2x (subst (cons 62 (1+ (1+ (rem (cdr (assoc 62 c2x)) 256)))) (assoc 62 c2x)))
            (setq c2x (append c2x (list (cons 62 2))))
          )
          (entupd (cdr (assoc -1 (entmod c1x))))
          (entupd (cdr (assoc -1 (entmod c2x))))
          (prompt "\nTrimmed curve broken into 2 parts... Remove part for trim manually and leave desired part...")
          (prompt "\nElapsed time : ") (prompt (ftoa (- (car (_vl-times)) ti))) (prompt " milliseconds...")
        )
        (prompt "\nInvalid curves relationship... Curves don't have vertical apparent intersection of current UCS...")
      )
    )
    (prompt "\nMissed, or picked entity not curve...")
  )
  (prompt "\nFor UNDO - type \"UNDO\" - \"Back\" option...")
  (*error* nil)
)

 

Edited March 22 by marko_ribar

[ramesh patel]

Thanks For reply But after run lips this error showing " AutoCAD variable setting rejected: PICKAUTO 3" how to solve this

[marko_ribar]

PICKAUTO 3 is allowed value... Look here : https://knowledge.autodesk.com/support/autocad/learn-explore/caas/CloudHelp/cloudhelp/2021/ENU/AutoCAD-Core/files/GUID-7BAAA374-8409-4296-B520-C5355941C836-htm.html

 

What CAD do you have? It should be fine... I've tested my template and it worked well on AutoCAD 2022 and in BricsCAD 22...

 

To fix issue, look for the order of variable "sysvarlst" and "sysvarvals", they are complementary and each (quote sysvar) matches one of the value from predefined values... So look for (quote pickauto), find it's place - it's value according to error should be 3... So change it's order by cutting it from there and perhaps assign 0 or 1 or 2 or 4 instead - choose what do you want - look into link above ^^^... When you set correctly both "sysvarlst" and "sysvarvals" - no error messages, routine should work as desired...

HTH.

M.R.

[ramesh patel]

I have a autodesk autoCad 2014

[ramesh patel]

this lips is not apparent with trim it break intersection but new vertex not move on attitude my requirement is trim with apparent intersection point 

[ramesh patel]

Sample.dwg

[marko_ribar]

OK, I see...

Try this mod...

 

(defun c:3dc-trim ( / vl-load *error* cmdfun cmderr catch_cont apply_cadr->car ftoa groupbynum sysvarpreset sysvarlst sysvarvals initvalueslst ti c1 c2 ip c1x c2x coord1 coord2 sa c1n c2n ) ;;; cad, doc, alo, spc - global variables (Visual Lisp main VLA-OBJECT pointers) ;;;

  (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 *error* ( m )
    (if (= 8 (logand 8 (getvar (quote undoctl))))
      (if (not (cmdfun (list "_.UNDO" "_E") t))
        (cmderr 23)
        (if doc
          (vla-endundomark doc)
        )
      )
    )
    (if initvalueslst
      (mapcar (function apply_cadr->car) initvalueslst)
    )
    (if doc
      (vla-regen doc acactiveviewport)
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  (defun cmdfun ( tokenslist flag ) ;;; 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 (vl-catch-all-apply (function command-s) tokenslist)))
          flag
        )
        (apply (function command-s) tokenslist)
      )
      (if flag
        (apply (function vl-cmdf) tokenslist)
        (apply (function command) tokenslist)
      )
    )
  )

  (defun cmderr ( linenum ) ;;; linenum - integer representing line number at which used (cmdfun) failed with success execution ;;;
    (prompt (strcat "\ncommand execution failure... error at line " (itoa linenum) " ..."))
  )

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

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

  (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
      )
    )
  )
  (if (= 8 (logand 8 (getvar (quote undoctl))))
    (if (not (cmdfun (list "_.UNDO" "_E") t))
      (cmderr 257)
      (if doc
        (vla-endundomark doc)
      )
    )
  )
  (if (not (cmdfun (list "_.UNDO" "_M") t))
    (cmderr 264)
    (if doc
      (vla-startundomark doc)
    )
  )
  (if
    (and
      (setq c1 (car (entsel "\nPick curve you want to trim with vertical plane of next curve...")))
      (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-curve-getstartpoint) (list c1))))
      (setq c2 (car (entsel "\nPick curve to trim with...")))
      (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-curve-getstartpoint) (list c2))))
    )
    (progn
      (setq ti (car (_vl-times)))
      (if
        (setq ip
          (inters
            (mapcar (function +)
              (list 0.0 0.0)
              (trans (vlax-curve-getstartpoint c1) 0 1)
            )
            (mapcar (function +)
              (list 0.0 0.0)
              (trans (vlax-curve-getendpoint c1) 0 1)
            )
            (mapcar (function +)
              (list 0.0 0.0)
              (trans (vlax-curve-getstartpoint c2) 0 1)
            )
            (mapcar (function +)
              (list 0.0 0.0)
              (trans (vlax-curve-getendpoint c2) 0 1)
            )
          )
        )
        (progn
          (setq ip (vlax-curve-getclosestpointtoprojection c1 ip (trans (list 0.0 0.0 1.0) 1 0 t)))
          (if (not (cmdfun (list "_.BREAK" c1 "_non" (trans ip 0 1) "_non" (trans ip 0 1)) t))
            (cmderr 302)
          )
          (if (not (vlax-erased-p c1))
            (progn
              (setq c2n (entlast))
              (setq c1n c1)
            )
            (progn
              (setq c2n (entlast))
              (entdel c2n)
              (setq c1n (entlast))
              (entdel c2n)
            )
          )
          (setq coord1 (safearray-value (variant-value (vla-get-coordinates (vlax-ename->vla-object c1n)))))
          (setq coord2 (safearray-value (variant-value (vla-get-coordinates (vlax-ename->vla-object c2n)))))
          (setq coord1 (groupbynum coord1 3))
          (setq coord2 (groupbynum coord2 3))
          (setq coord1
            (mapcar
              (function (lambda ( p )
                (if (equal p ip 1e-6)
                  (vlax-curve-getclosestpointtoprojection c2 ip (trans (list 0.0 0.0 1.0) 1 0 t))
                  p
                )
              ))
              coord1
            )
          )
          (setq coord2
            (mapcar
              (function (lambda ( p )
                (if (equal p ip 1e-6)
                  (vlax-curve-getclosestpointtoprojection c2 ip (trans (list 0.0 0.0 1.0) 1 0 t))
                  p
                )
              ))
              coord2
            )
          )
          (setq coord1 (apply (function append) coord1))
          (setq coord2 (apply (function append) coord2))
          (setq sa (vlax-make-safearray vlax-vbDouble (cons 1 (length coord1))))
          (vla-put-coordinates (vlax-ename->vla-object c1n) (vlax-make-variant (vlax-safearray-fill sa coord1)))
          (if (assoc 62 (setq c1x (entget c1n)))
            (setq c1x (subst (cons 62 (1+ (rem (cdr (assoc 62 c1x)) 256))) (assoc 62 c1x)))
            (setq c1x (append c1x (list (cons 62 1))))
          )
          (vla-update (vlax-ename->vla-object c1n))
          (setq sa (vlax-make-safearray vlax-vbDouble (cons 1 (length coord2))))
          (vla-put-coordinates (vlax-ename->vla-object c2n) (vlax-make-variant (vlax-safearray-fill sa coord2)))
          (if (assoc 62 (setq c2x (entget c2n)))
            (setq c2x (subst (cons 62 (1+ (1+ (rem (cdr (assoc 62 c2x)) 256)))) (assoc 62 c2x)))
            (setq c2x (append c2x (list (cons 62 2))))
          )
          (vla-update (vlax-ename->vla-object c1n))
          (entupd (cdr (assoc -1 (entmod c1x))))
          (entupd (cdr (assoc -1 (entmod c2x))))
          (prompt "\nTrimmed curve broken into 2 parts... Remove part for trim manually and leave desired part...")
          (prompt "\nElapsed time : ") (prompt (ftoa (- (car (_vl-times)) ti))) (prompt " milliseconds...")
        )
        (prompt "\nInvalid curves relationship... Curves don't have vertical apparent intersection of current UCS...")
      )
    )
    (prompt "\nMissed, or picked entity not curve...")
  )
  (prompt "\nFor UNDO - type \"UNDO\" - \"Back\" option...")
  (*error* nil)
)

 

Edited March 22 by marko_ribar