A Lisp to trim a line into 2 shorter lines? Is it possible?

[Anonymous]

I wonder if there is a lisp to trim a line into 2 line 5mm (both sides) as picture below?
Idea is choose a line, then create 2 lines both sides-->delete current line!
I am sorry for ask many simple problem in this forum, because for my job, I need it more smoothly.....Thank you for your support!

 

[ВeekeeCZ]

The length of new lines is always 5 or you want a prompt to specify it (each time?) ?

[Moshe-A · Accepted solution]

@Anonymous  hi,

Give this one a try. it support not only lines but also arcs,splines and open polylines

enjoy

Moshe

; Maintain Tip of Lines
(vl-load-com)

(defun c:M2L (/ asktip echo_results ; local functions
                deflen ss tiplen ctr curveLen p0 p1)

 (defun asktip (def / ask) 
  (initget (+ 2 4))
  (if (not (setq ask (getdist (strcat "\nTip of line to maintain <" (rtos def 2) ">: "))))
   (setq ask def)
   (setq def ask)
  )
 ); asktip  
  
 (defun echo_results ()
  (cond
   ((= ctr 0)
    nil
   )
   ((= ctr 1)
    (vlr-beep-reaction)
    (prompt "\n1 curve was to short.")
   )
   ( t 
    (vlr-beep-reaction)
    (prompt (strcat "\n" (itoa ctr) " curves were to short."))
   ) 
  ); cond
 ); echo_results
   
 (setvar "cmdecho" 0)
 (command "._undo" "_begin")

 (if (= (getvar "userr1") 0)
  (setq deflen (setvar "userr1" 5.0))
  (setq deflen (getvar "userr1"))
 )
 
 (if (and
      (setq tiplen (asktip deflen))
      (setq ss (ssget '((-4 . "<or")
                        (0 . "line,spline,arc")
                        (-4 . "<and") (0 . "lwpolyline,polyline") (70 . 0) (-4 . "and>")
                        (-4 . "or>")
                       )
               )   
      )
    )
  (progn
   (setq ctr 0) 
   (foreach ename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (setq curveLen (vlax-curve-getDistAtParam ename (vlax-curve-getEndParam ename)))

    (if (< curveLen (* tiplen 2.5))
     (setq ctr (1+ ctr)) 
     (progn 
      (setq p0 (vlax-curve-getClosestPointTo ename (vlax-curve-getPointAtParam ename (vlax-curve-getParamAtDist ename tiplen))))
      (setq p1 (vlax-curve-getClosestPointTo ename (vlax-curve-getPointAtParam ename (vlax-curve-getParamAtDist ename (- curveLen tiplen))))) 

      (command "._break" "_none" (list ename p0) "_f" "_none" p0 "_none" p1)
     ); progn
    ); if
   ); foreach

   (echo_results)   
  ); progn
 ); if

 (command "._undo" "_end")
 (setvar "cmdecho" 1)
  
 (princ)
)
  

[hak_vz]

Here you have two functions use which better suites you or both. First draws segments of desired length,

(defun c:drawsegs ( / p1 p2 p3 p4 e ent sh)
(setq sh (getreal "\nLength of short line segments >")) 
(while T
(command "_.line" pause pause "")
(setq e (entlast) ent (entget e))
(setq p1 (cdr (assoc 10 ent)) p2 (cdr (assoc 11 ent)))
(setq p3 (polar p1 (angle p1 p2) sh))
(setq p4 (polar p2 (angle p2 p1) sh))
(entdel e)
(command "_.line" p1 p3 "")
(command "_.line" p4 p2 "")
(princ)
)
(princ)
)

(defun c:tr2segs ( / p1 p2 p3 p4 e ent sh)
(setq sh (getreal "\nLength of short segments >"))
(while (setq e (car(entsel "Select line to trim in segments >")))
(setq ent (entget e))
(if (= (cdr (assoc 0 ent)) "LINE")
(progn
(setq p1 (cdr (assoc 10 ent)) p2 (cdr (assoc 11 ent)))
(cond 
((> (distance p1 p2) (* 2.0 sh))
(setq p3 (polar p1 (angle p1 p2) sh))
(setq p4 (polar p2 (angle p2 p1) sh))
(setq ent (subst (cons 11 p3) (assoc 11 ent) ent))
(entmod ent)
(command "_.copy" e "" p1 p4 "") 
)
((T (princ "\nLine is to short!"))
))
)
(princ "\nSelected object is not a line!")
)
)
(princ)
)

[pbejse]

---

@Anonymous wrote:

I wonder if there is a lisp to trim a line into 2 line 5mm (both sides) as picture below?
Idea is choose a line, then create 2 lines both sides-->delete current line!

---

(defun c:VeraVerto ( / ss i e ent )
(setq d (cond
	((getdist (strcat "\nEnter distance"
                 (if d (strcat " <" (rtos d) ">: ") ": ")
                            )))(5))
                ) 
  (if (setq ss (ssget "_:L" '((0 . "LINE"))))
    (repeat (setq i (sslength ss))
      	(setq e  (ssname ss (setq i (1- i)))
	      ent (entget e)
	)
	(entmake (append ent (list (cons 10 (vlax-curve-getPointAtDist e
					( - (getpropertyvalue e "Length") d))))))
	(entmod (append ent (list (Cons 11 (vlax-curve-getPointAtDist e d)))))
  	)
    )(princ)
  )

HTH

[Kent1Cooper]

---

@Moshe-A wrote:

....
      (-4 . "<and") (0 . "lwpolyline,polyline") (70 . 0)
....

---

That's going to have the same problem as in another recent thread -- it won't "see" open Polylines with linetype generation enabled [whose entry will be (70 . 128)].

[Kent1Cooper · Accepted solution]

Here's my take on it:

(vl-load-com)
(defun C:ENDS (/ ss n ent len)
  (initget (if *endslen* 6 7)); no zero, no negative, no Enter on first use
  (setq *endslen* ; global variable
    (cond
      ( (getdist ; User input
          (strcat
            "\nLength of end portions to retain"
            (if *endslen* (strcat " <" (rtos *endslen*) ">") "")
            ": "
          ); strcat
        ); getdist
      ); User input condition
      (*endslen*); on Enter [when allowed]: previous value
    ); cond
  ); setq      
  (if (setq ss (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))))
    (repeat (setq n (sslength ss))
      (setq ent (ssname ss (setq n (1- n))))
      (if
        (and
          (not (wcmatch (cdr (assoc 0 (entget ent))) "XLINE,MLINE"))
            ;; [inapplicable types accepted by *LINE in (ssget)]
          (>= ; long enough
            (setq len (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))
            (* *endslen* 2)
          ); >=
        ); and
        (command "_.break" ent ; giving only entity name goes into First mode
          "_none" (vlax-curve-getPointAtDist ent *endslen*)
          "_none" (vlax-curve-getPointAtDist ent (- len *endslen*))
        ); command
      ); if
    ); repeat
  ); if
  (princ)
); defun

It works on Lines, Arcs, Circles, Ellipses, Splines, and 2D or 3D lightweight or heavy Polylines.  In the case of Circles and closed LWPolylines or Splines, the result is accurately the two ends of the desired length, but in a single Arc/Polyline/Spline twice the specified end length, centered around the original's start/end point.  [Closed "heavy" 2D and 3D Polylines end up as separate end pieces, as with open-ended objects, touching at the original's start/end point.]

It remembers your end distance and offers it as default on subsequent use.

It could have Undo begin/end wrapping added, if desired, and if so, *error* handling to do the Undo end part in the event of a cancellation or error.

[Moshe-A]

@Kent1Cooper 

Thank you for this remark. maybe the solution here is to use (logand....)?

Moshe

[Kent1Cooper]

---

@Moshe-A wrote:

.... maybe the solution here is to use (logand....)?

....

---

There's a (logand)-equivalent (-4) code that will do it.  To find all open Polylines [of any variety] both with and without linetype generation enabled, among User-selected objects:

(ssget '((0 . "*POLYLINE") (-4 . "<NOT") (-4 . "&") (70 . 1) (-4 . "NOT>")))

(70 . bits): 1 = closed, 128 = linetype generation enabled;
(-4 . "&") is sort of like (logand) -- sees any value in the following entry that includes the listed bit [here, 1].

[Moshe-A]

wow @Kent1Cooper  i did not knew filter is so strong? that's amazing  - thanks you 

[Anonymous]

Thank you very much! Your lisp is saving my time!

[Anonymous]

Thank you for your lisp, But is seem does not works?

[Anonymous]

Thank you for your support, I tested but it does not works for me?

[Anonymous]

Many thanks for your reply, It is perfect!

[hak_vz]

---

@Anonymous wrote:

Thank you for your lisp, But is seem does not works?

---

both functions work on line objects

[vajiradayarathne07]

Thank you.., its work ❤️