Trim Extend to Polyline boundry

[BIGAL]

Just need a repeat loop for the lines to be extended or trimmed. Use a ssget to select the objects then.

 

(if (setq ss (ssget '((0 . "*LINE"))))
(repeat (setq x (sslength ss))
(setq obj2 (vlax-ename->vla-object (ssname ss (setq x (1- x)))))
is obj2 2 a line ?
is obj2 a pline ?

)
)

Good to see your trying to have a go at the code.

Edited October 27, 2023 by BIGAL

[danghungxda300449]

On 10/28/2023 at 5:45 AM, BIGAL said:

Just need a repeat loop for the lines to be extended or trimmed. Use a ssget to select the objects then.

 

(if (setq ss (ssget '((0 . "*LINE"))))
(repeat (setq x (sslength ss))
(setq obj2 (vlax-ename->vla-object (ssname ss (setq x (1- x)))))
is obj2 2 a line ?
is obj2 a pline ?

)
)

Good to see your trying to have a go at the code.

Thank you very much, I also understand your idea, but since I'm new to coding, I need some time to try it again. Whenever you have time, please help me write it if possible. Thanks You!

[BIGAL]

Try this

 

; simple trim extend of plines or lines inside say a rectang
; by AlanH Nov 2023

(defun c:wow ( / obj1 obj2 intpt oldsnap)
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(setq obj1 (vlax-ename->vla-object (car (entsel "\nPick object boundary "))))
(prompt "Use F fence option to drag over ")
(setq ss (ssget '((0 . "*LINE"))))
(if (= ss nil)
 (alert "no suitable objects selected ")
 (repeat (setq x (sslength ss))
  (setq obj2 (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
  (setq intpt (vlax-invoke obj2 'intersectWith obj1 acExtendThisEntity))
  (if (= (vlax-get obj2 'ObjectName) "AcDbLine")
   (progn
    (vlax-put obj2 'startpoint (list (nth 0 intpt)(nth 1 intpt)(nth 2 intpt)))
    (vlax-put obj2 'endpoint (list (nth 3 intpt)(nth 4 intpt)(nth 5 intpt)))
   )
   (progn
    (vlax-put Obj2 'coordinate 0 (list (nth 3 intpt)(nth 4 intpt)(nth 5 intpt)))
    (vlax-put Obj2 'coordinate 1 (list (nth 0 intpt)(nth 1 intpt)(nth 2 intpt)))
   )
  )
 )
)
(setvar 'osmode oldsnap)
(princ)
)

 

[danghungxda300449]

On 10/28/2023 at 5:45 AM, BIGAL said:

Just need a repeat loop for the lines to be extended or trimmed. Use a ssget to select the objects then.

 

(if (setq ss (ssget '((0 . "*LINE"))))
(repeat (setq x (sslength ss))
(setq obj2 (vlax-ename->vla-object (ssname ss (setq x (1- x)))))
is obj2 2 a line ?
is obj2 a pline ?

)
)

Good to see your trying to have a go at the code.

Thank you. Let me try to apply it to my lisp,

[BIGAL]

The posted code on sunday is a working version, did you try it.

[danghungxda300449]

8 hours ago, BIGAL said:

The posted code on sunday is a working version, did you try it.

I just tried it, and it works great. Thank you!

[danghungxda300449]

I asked the experts for a bit of help. The Lisp code that Exceed provided me with in the links (Page 1 :  https://www.theswamp.org/index.php?topic=3517.msg391379#msg391379) is excellent, but currently, it only allows me to select one cutting edge at a time. Could you help me modify the code so that I can select two or more cutting edges simultaneously before choosing the lines to trim or extend? Thank you.

[danghungxda300449]

On 11/10/2023 at 5:07 AM, BIGAL said:

The posted code on sunday is a working version, did you try it.

The Lisp you provided works fine. I have copied the application to the end of my lisp, the purpose is to cut/pull the lines created from the array (assigned as set ss); Can you help me fix it so that I don't need to re-select the lines (ss) but will receive the lines (in the ss set in the above lisp). I tried the code (according to the photo) but it only cuts/stretches the base line (ss1). Can you watch and help me?

Lisp after I concatenate: 

 ;;LISP: ARRAY And EXtend/TRIM
(defun C:rt ( / ss1 a d di n std
              )
  
(defun Ent_List_to_End(ent / a)
  (reverse
    (if(setq a(entnext ent))
       (cons ent(Ent_List_to_End a)))))

;-------------------------------------------------
(defun ss2ent (ss / sodt index lstent)
  (setq sodt (if ss(sslength ss)0)index 0)
  (repeat sodt(setq ent (ssname ss index)index (1+ index)lstent (cons ent lstent)
            )
    )
  (reverse lstent)
  )
;;;--------------------------------------------------------------------------------

                 
 (setq cmdo(getvar "cmdecho"))
 (setvar "cmdecho" 0)
 (princ "\nCopy array:")
 (setq ss1 (car (entsel "\nBase line:"))) 
 (setq p1(getpoint "\nArray starting point: "))
 (setq p2(getpoint p1 "\nArray end point: "))
 (setq kc2 (distance p2 (vlax-curve-getclosestpointto ss1 p2))) 
 (setq kc1 (distance p1 (vlax-curve-getclosestpointto ss1 p1))) 
 (setq p3 (vlax-curve-getclosestpointto ss1 p1))

 (if RT:distance
  (progn
   (setq std (rtos RT:distance 2 3))
   (setq d(getdist (strcat "\nArray distance <"std ">: ")))
     (if d
       (setq RT:distance d)
     )
  )
  (setq RT:distance(getdist "\nArray distance: "))
 )
 (setq V1(angle p1 p3))
 (setq V1(* (/ 180  pi) V1))
 (command "_.ucs" "z" V1)
 (setq d RT:distance)
(setq sol2 (fix (/ kc2 d)))
(setq sol1 (+ (fix (/ (+ kc1 kc2) d)) 0 (- sol2)))

(setq Ss '())      
(setq Ss (cons ss1 Ss))

(command "_.array" ss1 "" "r" 1 (+ sol2 1) d)
(setq sp (ssget "P"))
  (setq lst (ss2ent sp)
        cent (nth 0 lst)
        ss (ssadd)
        )
  
  (while (setq cent (entnext cent))
    (if (not (member cent lst))
      (setq ss (ssadd cent ss))
    )
  )
(foreach n eLst (ssadd n ss))
(command "_.ucs" "")
(setq V2(angle p3 p1))
(setq V2(* (/ 180  pi) V2))
(command "_.ucs" "z" V2)
(command "_.array" ss1 "" "r" 1 (+ sol1 1) d)
(setq sp (ssget "P"))
  (setq lst (ss2ent sp)
        cent (nth 0 lst)
        ss (ssadd)
        )
  
  (while (setq cent (entnext cent))
    (if (not (member cent lst))
      (setq ss (ssadd cent ss))
    )
  )
(setq eLst (Ent_List_to_End ss1))
(foreach n eLst (ssadd n ss))
(command "_.ucs" "")
(setq objectCount (sslength ss))
(princ (strcat "\ntotal number of line statues ss: " (itoa objectCount)))

 ;;; Code from Lisp 2 starts here:
  (setq obj1 (vlax-ename->vla-object (car (entsel "\nPick object boundary "))))
  (prompt "Use F fence option to drag over ")
  (if (setq ss (ssget '((0 . "*LINE"))))
    (repeat (setq x (sslength ss))
      (setq obj2 (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
      (setq intpt (vlax-invoke obj2 'intersectWith obj1 acExtendThisEntity))
      (if (= (vlax-get obj2 'ObjectName) "AcDbLine")
        (progn
          (vlax-put obj2 'startpoint (list (nth 0 intpt)(nth 1 intpt)(nth 2 intpt)))
          (vlax-put obj2 'endpoint (list (nth 3 intpt)(nth 4 intpt)(nth 5 intpt)))
        )
        (progn
          (vlax-put obj2 'coordinate 0 (list (nth 3 intpt)(nth 4 intpt)(nth 5 intpt)))
          (vlax-put obj2 'coordinate 1 (list (nth 0 intpt)(nth 1 intpt)(nth 2 intpt)))
        )
      )
    )
  )
  ;;; Code from Lisp 2 ends here
  
  (setvar "cmdecho" cmdo)
  (princ)
)

 

Can you watch and help me? Thanks  you!

Edited November 11, 2023 by danghungxda300449

[BIGAL]

This is a different scenario compared to a closed pline etc, so a second program. In the closed shape the end and start points don't matter. To make it work need to check what is say start end of line, this can be done in a few ways. The simplest is to select the line work near the bottom. See green line in image.

 

 

You then compare the distance of intpt to the 2 ends and swap if necessary so correct end is moved.

 

Will add to my to do list. Some one else may supply an answer sooner.

 

PS use the <> code tags for your posted code.

[danghungxda300449]

On 11/12/2023 at 5:10 AM, BIGAL said:

This is a different scenario compared to a closed pline etc, so a second program. In the closed shape the end and start points don't matter. To make it work need to check what is say start end of line, this can be done in a few ways. The simplest is to select the line work near the bottom. See green line in image.

 

 

You then compare the distance of intpt to the 2 ends and swap if necessary so correct end is moved.

 

Will add to my to do list. Some one else may supply an answer sooner.

 

PS use the <> code tags for your posted code.

Thanks for your great suggestions..!

[danghungxda300449]

On 11/12/2023 at 5:10 AM, BIGAL said:

This is a different sce compared to a closed pline etc, so a second program. In the closed shape the end and start points don't matter. To make it work need to check what is say start end of line, this can be done in a few ways. The simplest is to select the line work near the bottom. See green line in image.

You then compare the distance of intpt to the 2 ends and swap if necessary so correct end is moved.

 

Will add to my to do list. Some one else may supply an answer sooner.

 

PS use the <> code tags for your posted code.

I found on the forums an improved lisp and the purpose I wanted (selecting multiple boundaries). I tried it out and found that Lisp worked, but it wasn't stable, sometimes CAD couldn't cut/extend the lines (it was still the same drawing and the limit line check was a polyline, the lines to be cut were lines). ), I don't know if it's because of the variables or some other reason why the intersection function is unstable? Can you help me look at it and find out the reason to fix it so that Lisp works effectively? Thank you!

 

*Code lisp:

(defun C:MEXT (   /  LTSPLINE X)
  (defun *error* (msg)
    (if    Olmode
      (setvar 'osmode Olmode)
    )
    (if    (not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
  (setq Olmode (getvar "OSMODE"))
  (setq LtsPline (CV:ss-to-list (ssget (list (cons 0 "*LWPOLYLINE,POLYLINE"))) nil))
  (command "Zoom" "e")
  (mapcar '(lambda(x)(Ttt1 x)) LtsPline)
(setvar "OSMODE" Olmode)
(princ)
)

(defun Ttt1 (ent  / A  CMD ENTTTT HV KC12 LENT LENTL LEPT LINT LSPT P1 P2 PNT_D PNT_T SSET TV)
  (vl-load-com)
  (setq cmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setvar "OSMODE" 0)
  (command "UNDO" "Begin")
;;;  (while (not ent)
;;;    (setq ent (car (entsel "Select edge line: ")))
;;;    (if    ent
;;;      (progn
;;;    (setq entl (entget ent))
;;;      )
;;;    )ttt
;;;  )
  (if ent
    (progn
      (redraw ent 3)
      (setq a 0)
      (setq HV (LM:ssboundingbox (CV:List-to-ss (list ent))))
      (setq P1 (car HV))
      (setq P2 (cadr HV))
      (setq KC12 (distance P1 P2))
      (setq TV (list (/ (+ (car P1) (car P2)) 2) (/ (+ (cadr P1) (cadr P2)) 2)))
      (setq Pnt_T (list (- (car TV) (/ KC12 2)) (+ (cadr TV) (/ KC12 2))))
      (setq Pnt_D (list (+ (car TV) (/ KC12 2)) (- (cadr TV) (/ KC12 2))))
      (setq sset (ssget "W" Pnt_T Pnt_D (list (cons 0 "LINE"))))
      (if sset
    (repeat    (sslength sset)
      (setq    lentl (entget (setq lent (ssname sset a)))
        lspt  (cdr (assoc 10 lentl))
        lept  (cdr (assoc 11 lentl))
      )
      (setq entttt (ssname sset a))
      (setq lint (nth 0 (x_intlst ent entttt acExtendOtherEntity)))
      (if lint
        (progn

          (if (< (distance lint lspt) (distance lint lept))
        (entmod    (subst
              (cons 10 lint)
              (assoc 10 lentl)
              lentl
            )
        )
        (entmod    (subst
              (cons 11 lint)
              (assoc 11 lentl)
              lentl
            )
        )
          )
        )
      )
      (setq a (1+ a))
    )
    
      )
      (redraw ent 4)
    )
  )
  (setvar "CMDECHO" cmd)
  (command "UNDO" "End")
  (princ)
)

;;; by kuangdao at xdcad
(defun x_intlst    (obj1 obj2 param / intlst1 intlst2 ptlst)

  (if (= 'ENAME (type obj1))
    (setq obj1 (vlax-ename->vla-object obj1))
  )
  (if (= 'ENAME (type obj2))
    (setq obj2 (vlax-ename->vla-object obj2))
  )
  (setq
    intlst1 (vlax-variant-value (vla-intersectwith obj1 obj2 param))
  )
  (if (< 0 (vlax-safearray-get-u-bound intlst1 1))
    (progn
      (setq intlst2 (vlax-safearray->list intlst1))
      (while (> (length intlst2) 0)
    (setq ptlst   (cons (list (car intlst2) (cadr intlst2) (caddr intlst2))
                ptlst
              )
          intlst2 (cdddr intlst2)
    )
      )
    )
  )
  ptlst
)

(defun LM:ssboundingbox ( s / a b i m n o )
    (repeat (setq i (sslength s))
        (if
            (and
                (setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
                (vlax-method-applicable-p o 'getboundingbox)
                (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
            )
            (setq m (cons (vlax-safearray->list a) m)
                  n (cons (vlax-safearray->list b) n)
            )
        )
    )
    (if (and m n)
        (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))
    )
)

(defun CV:List-to-ss (lst / ss)
(setq ss (ssadd))
(foreach item lst
  (or (= (type item ) 'Ename)
   (setq item (vlax-vla-object->ename  item)))
  (setq ss (ssadd item ss))
)
ss
)

(defun CV:ss-to-list (ss vla / n e l)
  (setq n (sslength ss))
  (while (setq e (ssname ss (setq n (1- n))))
    (setq l (cons (if vla (vlax-ename->vla-object e) e) l))
  ) )

 

(MEXT) - Trim Extend to many EGDE.lsp

Edited November 17, 2023 by danghungxda300449