Trim any line in a layer to 5mm on both sides.

[timMRD2X]

Hey all,

This is my first time here so I apologize if I do anything wrong.

I am looking for a VBA or LISP code for trimming our bendlines. I would like to make each line that is in layer "4" 3mm shorter on both sides, then leave 5mm of line on both sides and trim the rest of the line. No matter where the line is or how long it is. just all the lines in layer "4"..

Is there anyone who can help me?

[ВeekeeCZ]

This generic tool should help you

If you need a layer filter to be implemented into the code, look here: 

https://lee-mac.com/ssget.html

(vl-load-com)

(defun c:Lengthen+ ( / *error osm* s i e l f)
  
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (if osm (setvar 'OSMODE osm))
    (princ))
  
  (if (and (setq s (ssget "_:L" '((0 . "LINE,LWPOLYLINE,ARC"))))
	   (setq osm (getvar 'osmode))
	   (setvar 'osmode 0)
	   
	   (or *la-opt1* (setq *la-opt1* "Middle"))
	   (not (initget "Start Middle End"))
	   (setq *la-opt1* (cond ((getkword (strcat "\nApply changes from [Start/Middle/End] <" *la-opt1* ">: ")))
				 (*la-opt1*)))
	   
	   (or *la-opt2* (setq *la-opt2* "Total"))
	   (not (initget "Delta Percent Total"))
	   (setq *la-opt2* (cond ((getkword (strcat "\nSpecify type of change [Delta/Percent/Total] <" *la-opt2* ">: ")))
				 (*la-opt2*)))
	   (cond ((= *la-opt2* "Delta")
		  (or *la-delta* (setq *la-delta* 1.))
		  (setq *la-delta* (cond ((getdist (strcat "\nEnter delta length <" (rtos *la-delta*) ">: ")))
					 (*la-delta*))))
		 ((= *la-opt2* "Percent")
		  (or *la-percent* (setq *la-percent* 100.))
		  (setq *la-percent* (cond ((getreal (strcat "\nEnter percentage length <" (rtos *la-percent*) ">: ")))
					   (*la-percent*))))
		 
		 ((= *la-opt2* "Total")
		  (or *la-total* (setq *la-total* 1.))
		  (setq *la-total* (cond ((getdist (strcat "\nSpecify total length <" (rtos *la-total*) ">: ")))
					 (*la-total*)))))
	   )
    (if (/= *la-opt1* "Middle")
      
      (progn
	(cond ((= *la-opt2* "Delta")	(command "_.lengthen" "_delta" *la-delta*))
	      ((= *la-opt2* "Percent")	(command "_.lengthen" "_percent" *la-percent*))
	      ((= *la-opt2* "Total")	(command "_.lengthen" "_total" *la-total*)))
	(repeat (setq i (sslength s))
	  (setq e (ssname s (setq i (1- i))))
	  (cond ((= *la-opt1* "Start")	(command (list e (vlax-curve-getpointatparam e (vlax-curve-getstartparam e)))))
		((= *la-opt1* "End")	(command (list e (vlax-curve-getpointatparam e (vlax-curve-getendparam e)))))))
	(if (> (getvar 'cmdactive) 0) (command "")))
      
      (if (= *la-opt2* "Delta")
	(progn
	  (command "_.lengthen" "_delta" (/ *la-delta* 2))
	  (repeat (setq i (sslength s))
	    (setq e (ssname s (setq i (1- i))))
	    (command (list e (vlax-curve-getpointatparam e (vlax-curve-getstartparam e)))
		     (list e (vlax-curve-getpointatparam e (vlax-curve-getendparam e)))))
	  (if (> (getvar 'cmdactive) 0) (command "")))
	
	(repeat (setq i (sslength s))   ;; Middle Percent and Total
	  (setq e (ssname s (setq i (1- i)))
		l (vlax-curve-getdistatparam e (vlax-curve-getendparam e))
		f (if (= *la-opt2* "Percent") (* l *la-percent* 0.01) *la-total*))
	  (command "_.lengthen" "_delta" (/ (- f l) 2)
		   (list e (vlax-curve-getpointatparam e (vlax-curve-getstartparam e)))
		   (list e (vlax-curve-getpointatparam e (vlax-curve-getendparam e)))
		   "")))))
  (*error* "end")
  )

[timMRD2X]

Your code works but it's not really what I'm looking for. I want to shorten all lines in layer '4' with one action, as shown in the attached drawing. I have put a before and after in the attached drawing.

Maybe some more explanation. The lines in layer '4' are the bendlines of our pieces. We would like to laser a mark line on our plates, but these lines are drawn over the entire length when we run them from Inventor, which takes us a lot of time to cut them into shortages every time.

[Kent1Cooper]

It seems easier to me to draw new short Lines and eliminate the long ones than to do all that shortening and breaking:

(defun C:XYZ (/ pad osm clay ss n lin len)
  (defun pad (d) (vlax-curve-getPointAtDist lin d)); point at distance
  (setq osm (getvar 'osmode) clay (getvar 'clayer))
  (if (setq ss (ssget "_X" '((0 . "LINE") (8 . "4"))))
    (progn ; then
      (setvar 'osmode 0)
      (setvar 'clayer "4")
      (repeat (setq n (sslength ss))
        (setq
          lin (ssname ss (setq n (1- n)))
          len (vlax-curve-getDistAtPoint lin (vlax-curve-getEndPoint lin))
        ); setq
        (if (> len 11)
          (command ; then
            "_.line" (pad 3) (pad 8 ) ""
            "_.line" (pad (- len 8)) (pad (- len 3)) ""
            "_.erase" lin ""
          ); command
        ); if
      ); repeat
      (setvar 'osmode osm)
      (setvar 'clayer clay)
    ); progn
  ); if
  (prin1)
)

[Change the XYZ command name to your liking.]

That leaves the little Lines shortened by 3 units and 5 units long as in your description in Message 1, though in your example they're really 10 for both -- you can get it like the drawing instead, by changing the 3's to 10's and the 8's to 20's in lines 15 & 16.  My line 13 is an arbitrary test length to avoid re-shortening already-short ones like those in your "after" situation -- set that 11 to something else if needed, or skip the test altogether if you would never have already-shortened ones.