Split scribe lines at midpoint and shorten to ends.

[davis.j]

Looking for assistance in creating a code to split all lines in my "Scribe" Layer and then set all of their lengths to 1" from the outer profile of the DXF "0" layer.

Found a method to cut the scribe lines in half here:
https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-break-multiple-lines-at-midpoin...

Then messed around with the code some but I cant get the lines on the left to change length. 😞

(defun C:LBH ; = Lines Break in Half
  (/ ss lin)
  (vl-load-com)
  
  (prompt "\nTo Break Lines in Half and Adjust Length,")
  
  ; Select all lines on the "Scribe" layer
  (setq ss (ssget "_X" '((8 . "Scribe") (0 . "LINE"))))
  
  ; Check if lines are selected
  (if ss
    (progn
      (setq n (sslength ss))
      
      ; Loop through each selected line
      (repeat n
        (setq lin (ssname ss (setq n (1- n))))
        
        ; Break the line in half
        (command "_.break" lin "_non"
                 (mapcar '/ (mapcar '+ (vlax-curve-getStartPoint lin) (vlax-curve-getEndPoint lin)) '(2 2 2))
                 "@")
        
        ; Calculate the new length (1 inch)
        (setq newLength 1.0)
        
        ; Get the start and end points of the new line segments
        (setq startPt (vlax-curve-getStartPoint lin))
        (setq endPt (vlax-curve-getEndPoint lin))
        
        ; Calculate the current length of the line
        (setq currentLength (distance startPt endPt))
        
        ; Calculate the scale factor to adjust the line to the new length
        (setq scaleFactor (/ newLength currentLength))
        
        ; Scale the line segment to the new length
        (command "_.scale" lin "" startPt scaleFactor)
      )
    )
    ; If no lines are selected
    (prompt "\nNo lines found on the \"Scribe\" layer.")
  )
  (princ)
)

This is how I want the code to work in picture form.

Example part:

Splits all lines at midpoint.

Then lengthen to 1" from the outer side.

Then do that for all of the segments.

Cant see in the photo but every scribe line is set to 1".

The purpose of this is so that the sheet metal brake operators can line up their laser to the scribe on both sides and work quicker.

[ВeekeeCZ]

Like this?

(defun c:ScribeShort ( / e i d b d)

  (if (setq s (ssget "_X" '((8 . "Scribe") (0 . "LINE"))))
    (repeat (setq i (sslength s))
      (setq d (entget (ssname s (setq i (1- i))))
	    b (cdr (assoc 10 d))
	    e (cdr (assoc 11 d)))
      (entmake (subst (cons 10 (polar e (angle e b) 1.)) (assoc 10 d) d))
      (entmod  (subst (cons 11 (polar b (angle b e) 1.)) (assoc 11 d) d))))
  (princ)
  )

[davis.j]

@ВeekeeCZ  Wow you are a life saver. That works amazing.

Could I ask of one more thing. My fabrication dept. prefers to have a .25" offset on the scribes from the edges. Is it possible to initially set it to 1.25" and then offset it away from the 0 edge to make it 1" total length?

[Kent1Cooper]

Or, with no need to make any new entit[y/ies], just Break them all between locations 1" in from each end, In the case of Lines, this is made easier than for other things by the fact that Parameter values in (vlax-curve-...) terms are lengths along the Line:

(defun C:1ends (/ ss n lin)
  (if (setq ss (ssget '((0 . "LINE") (8 . "Scribe"))))
    (repeat (setq n (sslength ss)); then
      (setq lin (ssname ss (setq n (1- n))))
      (command "_.break" lin
        "_non" (vlax-curve-getPointAtParam lin (1- (vlax-curve-getEndParam lin)))
        "_non" (vlax-curve-getPointAtParam lin 1)
      ); command
    ); repeat
  ); if
  (prin1)
)

The feeding in of the entity name ['lin' variable'] as a first input to the Break command [it will automatically go into First mode] ensures that, no matter what your Zoom level is, it will Break the right one, and the first break-point pick will not "see" a different one.

It could use all the usual stuff [Undo begin/end wrapping, *error* handling if you include turning off running Osnap, etc.].

[Kent1Cooper · Accepted solution]

---

@davis.j wrote:

.... My fabrication dept. prefers to have a .25" offset on the scribes from the edges. Is it possible to initially set it to 1.25" and then offset it away from the 0 edge to make it 1" total length?

---

Or, shorten it by 0.25" at each end, then Break it between 1"-in points from the shortened ends:

(defun C:1ends (/ ss n lin)
  (if (setq ss (ssget '((0 . "LINE") (8 . "Scribe"))))
    (repeat (setq n (sslength ss)); then
      (setq lin (ssname ss (setq n (1- n))))
      (command
        "_.break" lin
          "_non" (vlax-curve-getStartPoint lin)
          "_non" (vlax-curve-getPointAtDist lin 0.25)
        "_.break" lin
          "_non" (vlax-curve-getPointAtParam lin (- (vlax-curve-getEndParam lin) 0.25))
          "_non" (vlax-curve-getEndPoint lin)
        "_.break" lin
          "_non" (vlax-curve-getPointAtParam lin (1- (vlax-curve-getEndParam lin)))
          "_non" (vlax-curve-getPointAtParam lin 1)
      ); command
    ); repeat
  ); if
  (prin1)
)

In the case of the start end of a Line, (vlax-curve-getPointAtDist) and (vlax-curve-GetPointAtParam) are interchangeable.

Another approach to the 1/4" shortening would be to SCALE the Line about its midpoint, using its current length as a Reference size and 1/2" less as the new size.  That would take care of both ends in one command.

Or LENGTHEN, with its Delta option and a negative 1/4" Delta value, from each end.

[ВeekeeCZ · Accepted solution]

Ok, if you prefer this version...

(defun c:ScribeShorten ( / e i d b d)
  
  (if (setq s (ssget "_X" '((8 . "Scribe") (0 . "LINE"))))
    (repeat (setq i (sslength s))
      (setq d (entget (ssname s (setq i (1- i))))
	    b (cdr (assoc 10 d))
	    e (cdr (assoc 11 d)))
      (entmake (append d
		       (list (cons 10 (polar e (angle e b) 1.25)))
		       (list (cons 11 (polar e (angle e b) 0.25)))))
      (entmod  (append d
		       (list (cons 10 (polar b (angle b e) 0.25)))
		       (list (cons 11 (polar b (angle b e) 1.25)))))))
  (princ)
  )

[davis.j]

@ВeekeeCZ @Kent1Cooper 

Thank you so much for your help. This will save my ORG plenty of time. Both solutions accepted as answers.