Is there a command or lisp that could reduce the length of line at both ends?

[Mageblue]

Hi

Is there a command or lisp that could reduce the length of line at both ends by certain amount, say 100(without prompt to ask how much to reduce)?

 

Heaps of thanks.

[BIGAL]

It can be done by lisp the easiest way is to pick line erase it and redraw it shorter or play with the endpoints and entity update. I would make it so it asks first time for the change +/- len then pick multiple lines. A choice now to either keep for entire session or reset till you do again with different length. If you know the lengths you could do a shorthand command with predefined values then run main lisp program.

 

(defun C:100 ()(setq len 100)(load "shortenline"))

[Dadgad]

Welcome to the forum.

 

If you were doing this on the fly, and the distance by which you needed it shortened was not critical, you could use SCALE, and define the basepoint as the midpoint of the line.

[Mageblue]

It can be done by lisp the easiest way is to pick line erase it and redraw it shorter or play with the endpoints and entity update. I would make it so it asks first time for the change +/- len then pick multiple lines. A choice now to either keep for entire session or reset till you do again with different length. If you know the lengths you could do a shorthand command with predefined values then run main lisp program.

 

(defun C:100 ()(setq len 100)(load "shortenline"))

 

Thank you for the reply.

 

got this: 'error: LOAD failed: "shortenline"

 

Is it possible to have one lisp that reduces lines with varies lengths by 100 at both ends?

[Mageblue]

Actually this '100 reduction' is fixed, it is that the line lengths varies because I try to modify many lines at the same time, they all need to be cut off by 100 at both ends.

[MSasu]

Something like this?

; Shorten Line at Both Ends routine (28-VIII-2012)
(defun c:SLBE( / lengthToCut ssetLine assocLine Point1st Point2nd theAngle )
(setq lengthToCut 100.0)   ;adjust total length to be removed from line

(while (setq ssetLine (ssget "_:S" '((0 . "LINE"))))
 (setq assocLine (entget (ssname ssetLine 0))
       Point1st  (cdr (assoc 10 assocLine))
       Point2nd  (cdr (assoc 11 assocLine))
       theAngle  (angle Point1st Point2nd))
 (entmod (subst (cons 11 (polar Point2nd (+ pi theAngle) (* 0.5 lengthToCut)))
                (assoc 10 assocLine)
                (subst (cons 10 (polar Point1st theAngle (* 0.5 lengthToCut)))
                       (assoc 11 assocLine)
                       assocLine)))
)

(princ)
)

[Mageblue]

Something like this?

; Shorten Line at Both Ends routine (28-VIII-2012)
(defun c:SLBE( / lengthToCut ssetLine assocLine Point1st Point2nd theAngle )
(setq lengthToCut 100.0)   ;adjust total length to be removed from line

(while (setq ssetLine (ssget "_:S" '((0 . "LINE"))))
 (setq assocLine (entget (ssname ssetLine 0))
       Point1st  (cdr (assoc 10 assocLine))
       Point2nd  (cdr (assoc 11 assocLine))
       theAngle  (angle Point1st Point2nd))
 (entmod (subst (cons 11 (polar Point2nd (+ pi theAngle) (* 0.5 lengthToCut)))
                (assoc 10 assocLine)
                (subst (cons 10 (polar Point1st theAngle (* 0.5 lengthToCut)))
                       (assoc 11 assocLine)
                       assocLine)))
)

(princ)
)

 

 

That's it !!!

Thank you very much !

[MSasu]

You're welcome!

[Tharwat]

Another one with multiple selection set ..

 

(defun c:Test (/ no ss in sn st en e an)
 (setq no 0)
 (if (setq ss (ssget "_:L" '((0 . "LINE"))))
   (repeat (setq in (sslength ss))
     (setq sn (ssname ss (setq in (1- in))))
     (if (> (distance (setq st (cdr (assoc 10 (setq e (entget sn))))) (setq en (cdr (assoc 11 e)))) 200.)
       (progn (setq an (angle st en))
              (entmod (subst (cons 10 (polar st an 100.))
                             (assoc 10 e)
                             (subst (cons 11 (polar en (* an 2.) -100.)) (assoc 11 e) e)
                             )
                      )
              )
       (setq no (1+ no))
       )
     )
   (princ)
   )
 (if (> no 0)
   (princ (strcat "\n < " (itoa no) " > Line(s) are equal or shorter than 200. units !!"))
   )
 (princ)
 )

[MSasu]

Another alternative, just for the sake of variation:

; Scale Line at Both Ends routine (28-VIII-2012)
(defun c:SLBE( / lengthToCut ssetLine entityLine assocLine lengthLine Point1st Point2nd )
(setq lengthToCut 100.0)   ;adjust total length to be removed from line

(while (setq ssetLine (ssget "_:S" '((0 . "LINE"))))
 (setq assocLine  (entget (setq entityLine (ssname ssetLine 0)))
       lengthLine (distance (setq Point1st (cdr (assoc 10 assocLine)))
                            (setq Point2nd (cdr (assoc 11 assocLine)))))

 (if (> lengthLine lengthToCut)
  (command "_.SCALE" entityLine ""
           "_non" (polar Point1st (angle Point1st Point2nd)
                         (* 0.5 lengthLine))
           (/ (- lengthLine lengthToCut)
              lengthLine))
  (prompt "Unable to scale down this item!")
 )
)

(princ)
)

[Lee Mac]

Here is another old one of mine, to also work for 3D Lines, in any UCS:

 

;; Shorten  -  Lee Mac
;; Shortens a selected Line equally at both ends

(defun c:short ( / a b d l n p q r v )
   (while
       (progn (setvar 'errno 0) (setq l (car (entsel "\nSelect Line to Shorten: ")))
           (cond
               (   (= 7 (getvar 'errno))
                   (princ "\nMissed, try again.")
               )
               (   (= 'ename (type l))
                   (if (and
                           (= "LINE" (cdr (assoc 0 (setq l (entget l)))))
                           (setq p (cdr (assoc 10 l))
                                 q (cdr (assoc 11 l))
                                 d (distance p q)
                           )
                           (not (equal d 0.0 1e-)
                       )
                       (if (setq n (getdist (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p q) "\nSpecify New Endpoint: "))
                           (progn
                               (setq r (/ (- (/ d 2.0) n) d)
                                     v (mapcar '* (mapcar '- q p) (list r r r))
                                     l (subst (cons 10 (mapcar '+ p v)) (assoc 10 l) l)
                                     l (subst (cons 11 (mapcar '- q v)) (assoc 11 l) l)
                               )
                               (entmod l)
                           )
                       )
                       (princ "\nInvalid object selected.")
                   )
               )
           )
       )
   )
   (princ)
)

[Aftab Younas]

On 8/29/2012 at 9:12 AM, MSasu said:

Another alternative, just for the sake of variation:

 

; Scale Line at Both Ends routine (28-VIII-2012)
(defun c:SLBE( / lengthToCut ssetLine entityLine assocLine lengthLine Point1st Point2nd )
(setq lengthToCut 100.0)   ;adjust total length to be removed from line

(while (setq ssetLine (ssget "_:S" '((0 . "LINE"))))
 (setq assocLine  (entget (setq entityLine (ssname ssetLine 0)))
       lengthLine (distance (setq Point1st (cdr (assoc 10 assocLine)))
                            (setq Point2nd (cdr (assoc 11 assocLine)))))

 (if (> lengthLine lengthToCut)
  (command "_.SCALE" entityLine ""
           "_non" (polar Point1st (angle Point1st Point2nd)
                         (* 0.5 lengthLine))
           (/ (- lengthLine lengthToCut)
              lengthLine))
  (prompt "Unable to scale down this item!")
 )
)

(princ)
)

 

 

hi this is perfectly fine but can not select multiple lines.. please adjust