Author Topic: Trim and Replace Line with One Pick  (Read 12332 times)

0 Members and 1 Guest are viewing this topic.

2cook2

  • Guest
Trim and Replace Line with One Pick
« on: February 07, 2012, 10:51:46 AM »
I have a LISP routine that trims a line in between 2 parallel lines and then prompts to drawn  a new line with  different color and linetype.  This requires 3 picks to work.  I would like to just pick on the trimed line and have it find the endpoints of the new line and draw it in.  I'm stuck at how to find the 2 closest intersections from the one pick.  Anybody have  something close that I can use to go by.

I have attached a picture of what I am trying to do.

Thanks

ronjonp

  • Needs a day job
  • Posts: 7526
Re: Trim and Replace Line with One Pick
« Reply #1 on: February 07, 2012, 11:06:04 AM »
Maybe this can help you get the intersection point(s):

Code: [Select]
(setq o1 (car (entsel)))
(setq o2 (car (entsel)))
(vlax-invoke
  (vlax-ename->vla-object o1)
  'intersectwith
  (vlax-ename->vla-object o2)
  acextendnone
)

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

efernal

  • Bull Frog
  • Posts: 206
Re: Trim and Replace Line with One Pick
« Reply #2 on: February 07, 2012, 12:46:08 PM »
Code - Auto/Visual Lisp: [Select]
  1. ;;                                                         Eduardo Fernal, 07/02/2012
  2. ;;      |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  3. (DEFUN c:teste (/ cn dd di e0 e1 e2 e3 os pa pb s1 s2 sn dxf int p10 p11 p1a pt1 pt2)
  4.   (IF (AND (SETQ e1 (ENTSEL "\n-> Selecione a linha a aparar : "))
  5.            (= (CDR (ASSOC 0 (SETQ dxf (ENTGET (CAR e1))))) "LINE")
  6.       )
  7.     (PROGN (SETQ os (GETVAR "OSMODE"))
  8.            (SETVAR "OSMODE" 0)
  9.            (SETQ p1  (CADR e1)
  10.                  p10 (CDR (ASSOC 10 dxf))
  11.                  p11 (CDR (ASSOC 11 dxf))
  12.                  p1a (INTERS (POLAR p1 (- (ANGLE p10 p11) (* PI 0.5)) 1000.0)
  13.                              (POLAR p1 (+ (ANGLE p10 p11) (* PI 0.5)) 1000.0)
  14.                              p10
  15.                              p11
  16.                      )
  17.            )
  18.            (IF p1a
  19.              (SETQ p1 p1a
  20.                    s1 (SSGET "_F" (LIST p1 p10) '((0 . "LINE")))
  21.                    s2 (SSGET "_F" (LIST p1 p11) '((0 . "LINE")))
  22.              )
  23.            )
  24.            (IF (AND s1 s2)
  25.              (PROGN (SETQ e0  (CAR e1)
  26.                           s1  (IF (SSMEMB e0 s1)
  27.                                 (SSDEL e0 s1)
  28.                                 s1
  29.                               )
  30.                           s2  (IF (SSMEMB e0 s2)
  31.                                 (SSDEL e0 s2)
  32.                                 s2
  33.                               )
  34.                           sn  (SSLENGTH s1)
  35.                           cn  0
  36.                           di  (DISTANCE p1 p10)
  37.                           pt1 p10
  38.                     )
  39.                     (REPEAT sn
  40.                       (SETQ e2  (SSNAME s1 cn)
  41.                             dxf (ENTGET e2)
  42.                             pa  (CDR (ASSOC 10 dxf))
  43.                             pb  (CDR (ASSOC 11 dxf))
  44.                             int (INTERS p1 p10 pa pb)
  45.                             dd  (DISTANCE p1 int)
  46.                             pt1 (IF (< dd di)
  47.                                   int
  48.                                   pt1
  49.                                 )
  50.                             cn  (1+ cn)
  51.                       )
  52.                     )
  53.                     (SETQ sn  (SSLENGTH s2)
  54.                           cn  0
  55.                           di  (DISTANCE p1 p11)
  56.                           pt2 p11
  57.                     )
  58.                     (REPEAT sn
  59.                       (SETQ e3  (SSNAME s2 cn)
  60.                             dxf (ENTGET e3)
  61.                             pa  (CDR (ASSOC 10 dxf))
  62.                             pb  (CDR (ASSOC 11 dxf))
  63.                             int (INTERS p1 p11 pa pb)
  64.                             dd  (DISTANCE p1 int)
  65.                             pt2 (IF (< dd di)
  66.                                   int
  67.                                   pt2
  68.                                 )
  69.                             cn  (1+ cn)
  70.                       )
  71.                     )
  72.                     (COMMAND "_.BREAK" (CAR e1) pt1 pt2)
  73.                     (IF (NULL (TBLSEARCH "LTYPE" "EFernal"))
  74.                       (ENTMAKE '((0 . "LTYPE")
  75.                                  (100 . "AcDbSymbolTableRecord")
  76.                                  (100 . "AcDbLinetypeTableRecord")
  77.                                  (2 . "EFernal")
  78.                                  (70 . 0)
  79.                                  (3 . "EFernal __ . __ . __ . __ . __ . __ . __ . __")
  80.                                  (72 . 65)
  81.                                  (73 . 4)
  82.                                  (40 . 25.4)
  83.                                  (49 . 12.7)
  84.                                  (74 . 0)
  85.                                  (49 . -6.35)
  86.                                  (74 . 0)
  87.                                  (49 . 0.0)
  88.                                  (74 . 0)
  89.                                  (49 . -6.35)
  90.                                  (74 . 0)
  91.                                 )
  92.                       )
  93.                     )
  94.                     (ENTMAKE (LIST (CONS 0 "LINE")
  95.                                    (CONS 6 "EFernal") ; change here
  96.                                    (CONS 8 "SECTION") ; change here
  97.                                    (CONS 10 pt1)
  98.                                    (CONS 11 pt2)
  99.                                    (CONS 62 5) ; change here
  100.                              )
  101.                     )
  102.              )
  103.              nil
  104.            )
  105.            (SETVAR "OSMODE" os)
  106.     )
  107.   )
  108.   (PRINC)
  109. )
  110.  
e.fernal

ronjonp

  • Needs a day job
  • Posts: 7526
Re: Trim and Replace Line with One Pick
« Reply #3 on: February 07, 2012, 12:55:35 PM »
Here's another for you to mull over :)

Code: [Select]
;;For single selection
(defun c:xx (/ e e2 ep o pts sp ss x)
  (vl-load-com)
  (defun _foo (el p1 p2)
    (entmakex (append (reverse (cdddr (reverse el))) (list (cons 10 p1)) (list (cons 11 p2))))
  )
  (defun ss2lst (ss / e n out)
    (setq n -1)
    (while (setq e (ssname ss (setq n (1+ n)))) (setq out (cons (vlax-ename->vla-object e) out)))
  )
  (if (and (setq e (entsel "\nSelect line: "))
   (setq e (car e))
   (equal (cdr (assoc 0 (entget e))) "LINE")
   (setq o (vlax-ename->vla-object e))
   (setq sp (vlax-curve-getstartpoint e))
   (setq ep (vlax-curve-getendpoint e))
   (setq ss (ssget "_f" (list sp ep) (list '(0 . "~INSERT"))))
   (> (sslength ss) 2)
      )
    (progn (setq pts
  (mapcar
    '(lambda (x) (vlax-invoke o 'intersectwith x acextendnone))
    (vl-remove-if '(lambda (x) (equal (vla-get-handle o) (vla-get-handle x))) (ss2lst ss))
  )
   )
   (setq pts (vl-sort pts '(lambda (d1 d2) (< (distance sp d1) (distance sp d2)))))
   (setq e2 (_foo (entget e) (car pts) (last pts)))
   ;;change layer name here for break piece
   (entmod (subst '(8 . "hidden") (assoc 8 (entget e2)) (entget e2)))
   (redraw e2 3)
   (_foo (entget e) sp (car pts))
   (_foo (entget e) ep (last pts))
   (entdel e)
    )
    (princ "\nObject needs to be a line...")
  )
  (princ)
)


Code: [Select]
;;For multiple selection
(defun c:xx (/ e e2 ep o pts sel sp ss x)
  (vl-load-com)
  (defun _foo (el p1 p2)
    (entmakex (append (reverse (cdddr (reverse el))) (list (cons 10 p1)) (list (cons 11 p2))))
  )
  (defun ss2lst (ss / e n out)
    (setq n -1)
    (while (setq e (ssname ss (setq n (1+ n))))
      (setq out (cons (list e (vlax-ename->vla-object e)) out))
    )
  )
  (princ "\nSelect lines to break: ")
  (if (setq sel (ssget '((0 . "LINE"))))
    (foreach x (ss2lst sel)
      (if (and (setq e (car x))
       (setq o (cadr x))
       (setq sp (vlax-curve-getstartpoint e))
       (setq ep (vlax-curve-getendpoint e))
       (setq ss (ssget "_f" (list sp ep) (list '(0 . "~INSERT"))))
       (> (sslength ss) 2)
       (setq
pts (vl-remove 'nil
(mapcar '(lambda (x) (vlax-invoke o 'intersectwith x acextendnone))
(vl-remove-if
  '(lambda (x) (equal (vla-get-handle o) (vla-get-handle x)))
  (mapcar 'cadr (ss2lst ss))
)
)
     )
       )
  )
(progn (setq pts (vl-sort pts '(lambda (d1 d2) (< (distance sp d1) (distance sp d2)))))
       (setq e2 (_foo (entget e) (car pts) (last pts)))
       ;;change layer name here for break piece
       (entmod (subst '(8 . "hidden") (assoc 8 (entget e2)) (entget e2)))
       (redraw e2 3)
       (_foo (entget e) sp (car pts))
       (_foo (entget e) ep (last pts))
       (entdel e)
)
      )
    )
  )
  (princ)
)
« Last Edit: February 07, 2012, 03:18:13 PM by ronjonp »

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

chlh_jd

  • Guest
Re: Trim and Replace Line with One Pick
« Reply #4 on: February 09, 2012, 08:01:54 AM »
Do I be right you want this method 'Trim' ?
Code: [Select]
(defun c:test (/ e pt el l a b c p1 p2 p3 p4 p10 p11 oce)
  ;;trim and add new line for trim-space
  ;; by GSLS(SS) 2012-2-9
  (defun dxf (a l)
    (cdr (assoc a l))
  )
  (defun mindis-pt (l pt)
    (car
      (vl-sort l
       (function (lambda (e1 e2)
   (< (distance pt e1) (distance pt e2))
)
       )
      )
    )
  )
  (setq oce (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq e (entlast))
  (prompt "Select a line :")
  (command "Trim" "") 
  (while (setq pt (entsel "\nSelect a line :"))
    (command pt)   
    (if (not (eq e (entlast)))
      (progn
(setq e (entlast)
      b   (entget (car pt))
      c   (entget e)
      p1  (dxf 10 b)
      p2  (dxf 11 b)
      p3  (dxf 10 c)
      p4  (dxf 11 c)
      p11 (mindis-pt (list p3 p4) p1)
      p10 (mindis-pt (list p1 p2) p3)
)
(entmake
  (list (cons 0 "LINE")
(cons 10 p10)
(cons 11 p11)
(cons 6 "DASHED");_LineType must be loaded
(cons 62 251)
  )
)
)
      )   
  )
  (command "")
  (setvar "cmdecho" oce)
  (princ)
)

chlh_jd

  • Guest
Re: Trim and Replace Line with One Pick
« Reply #5 on: February 09, 2012, 09:44:32 AM »
For multi method , you can use it like trim command .
Code: [Select]
;;multi method
(defun c:tt (/ mytrim_entsel err oce e el ell ps ss s se a b p1 p2 p3 p4 p10 p11)
  ;;trim and add new line for trim-space
  ;; by GSLS(SS) 2012-2-9
  (defun *error* (msg)
    (command)
    (command)
    (if (or (= msg "Function cancelled")
    (= msg "quit / exit abort")
)
      (princ msg)
      (princ (strcat "\n错误: " msg))
    )
    (setvar "cmdecho" oce)
    (setq *error* err)
  )
  (defun dxf (a l)
    (cdr (assoc a l))
  )
  (defun mindis-pt (l pt)
    (car
      (vl-sort l
       (function (lambda (e1 e2)
   (< (distance pt e1) (distance pt e2))
)
       )
      )
    )
  )
  (defun ss-get-d (pt p1 p2)
    (car (trans (mapcar (function -) pt p2)
0
(mapcar (function -) p1 p2)
)
    )
  )
  (defun vlex-ex2con (pts)
    (mapcar (function (lambda (x)
(trans x 0 0)
      )
    )
    (list (car pts)
  (list (caadr pts) (cadar pts))
  (cadr pts)
  (list (caar pts) (cadadr pts))
    )
    )
  )
 (defun mytrim_entsel
     (STR FILTER / PT en SS om is)
  (setq om (getvar "MODEMACRO"))
  (if (/= (type STR) (quote STR))
    (princ "\n变量类型不对,STR应为字符串。\n")
    (progn
      (if (/= (type FILTER) (quote list))
(princ "\n变量类型不对,FILTER应为表。\n")
(progn
  (princ STR)
  (setvar "MODEMACRO" STR) ;_这里添加选择修改
  (setq PT (grread t 4 2)
IS t
  )
  (while (and (/= 3 (car PT))
      (/= 11 (car PT))
      (/= 25 (car pt))
      IS
)
    (cond
      ((and (= 2 (car pt))
    (or (= 13 (cadr pt)) (= 32 (cadr pt)))
       ) ;_Enter,Space.
       (setq IS nil)
      )
      ((and (= 5 (car PT)) (vl-consp (cadr PT)))
       (setq SS (ssget (cadr PT) FILTER))
       (if en
(redraw en 4)
       )
       (setq en NIL)
       (if SS
(progn
   (setq en (ssname SS 0))
   (redraw en 3)
)
(setvar "MODEMACRO" om)
       )
      )
    ) ;_cond
    (setq PT (grread t 4 2))
  ) ;_while
  (setvar "MODEMACRO" om)
  (if (and (/= 11 (car pt)) (/= 25 (car pt)))
    (progn
      (setq PT (cadr PT))
      (setq SS (ssget PT FILTER))
      (setvar "LASTPOINT" PT)
      (if en
(redraw en 4)
      )
      (setq en NIL)
      (if SS
(progn
  (setq en (ssname SS 0))
  (list en (trans PT 1 0))
)
(list nil (trans PT 1 0))
      )
    )
    (if en
      (redraw en 4)
    )
  )
)
      )
    )
  )
)
  (setq oce (getvar "CMDECHO")
err *error*
e   (entlast)
  )
  (setvar "CMDECHO" 0)
  (prompt "Trim and Connect rutine ...")
  (command "Trim" "")
  (while
    (or
      (and (setq
     pt (mytrim_entsel "\nSelect a line or Select Corner 1st point :"
   '((0 . "LINE"))    
)
   )
   (car pt)
   )
      (and (setq p1 (cadr pt))
   (not(setq pt nil))
   (setq p2 (getcorner p1 "\nSelect Corner 2nd point :"))
      )
    )
     (if pt
       (progn
(command pt)
(if (not (eq e (entlast)))
   (progn
     (setq e   (entlast)
   a   (entget (car pt))
   b   (entget e)
   p1  (dxf 10 a)
   p2  (dxf 11 a)
   p3  (dxf 10 b)
   p4  (dxf 11 b)
   p11 (mindis-pt (list p3 p4) p1)
   p10 (mindis-pt (list p1 p2) p3)
     )
     (entmake
       (list (cons 0 "LINE")
     (cons 10 p10)
     (cons 11 p11)
     (cons 6 "DASHED") ;_LineType must be loaded
     (cons 62 251)
       )
     )
   )
)
       )
       (if (if (setq ps (vlex-ex2con (list p1 p2)))
     (setq ss (ssget "CP" ps '((0 . "LINE"))))
     (setq ss (ssget "_F" p1 p2 '((0 . "LINE"))))
   )
(progn
   (if (> (atoi (substr (ver) 13)) 2005)
     (command "C" p1 p2)
     (command "F" p1 p2)
   )
   (while (setq e (entnext e))
     (if (= (dxf 0 (entget e)) "LINE")
       (setq el (cons e el))
     )
   )
   (setq e (entlast))
   (if el
     (progn
       (setq el (reverse el)
     i -1
       )
       (while (setq s (ssname ss (setq i (1+ i))))
(setq is  T
       ell el
       se  (entget s)
       p1  (dxf 10 se)
       p2  (dxf 11 se)
)
(while (and is ell)
   (setq a   (car ell)
b   (entget a)
ell (cdr ell)
p3  (dxf 10 b)
p4  (dxf 11 b)
   )
   (if (and (equal (ss-get-d p3 p1 p2)
   0
   1e-3
    )
    (equal (ss-get-d p4 p1 p2)
   0
   1e-3
    )
       )
     (progn
       (setq is nil
     p11 (mindis-pt (list p3 p4) p1)
     p10 (mindis-pt (list p1 p2) p3)
     el (vl-remove a el)
       )
       (entmake
(list (cons 0 "LINE")
       (cons 10 p10)
       (cons 11 p11)
       (cons 6 "DASHED") ;_LineType must be loaded
       (cons 62 251)
)
       )
     )
   )
)
       )
     )
   )
)
(princ "\nNot Lines Selected , Please Select again :")
       )
     )
  )
  (command "")
  (setvar "CMDECHO" oce)
  (setq *error* err)
  (princ)
)
« Last Edit: February 09, 2012, 10:45:00 AM by chlh_jd »

Ketxu

  • Newt
  • Posts: 109
Re: Trim and Replace Line with One Pick
« Reply #6 on: February 09, 2012, 11:09:33 AM »
How about Curve :">

Sam

  • Bull Frog
  • Posts: 201
Re: Trim and Replace Line with One Pick
« Reply #7 on: February 10, 2012, 02:34:10 AM »
dear sir chlh_jd

nice program


Every time we waste electricity, we put our planet's future in the dark. Let's turn around our attiude and start saving power and our planet, before it's too late
http://www.theswamp.org/donate.html

chlh_jd

  • Guest
Re: Trim and Replace Line with One Pick
« Reply #8 on: February 23, 2012, 01:20:06 PM »
dear sir chlh_jd

nice program



You're wellcome !

chlh_jd

  • Guest
Re: Trim and Replace Line with One Pick
« Reply #9 on: February 23, 2012, 01:21:52 PM »
How about Curve :">
I believe it can be extend to All Curve-types , recently have no time ; I'll try it later .

martinle

  • Newt
  • Posts: 22
Re: Trim and Replace Line with One Pick
« Reply #10 on: February 24, 2012, 12:17:00 AM »
Hello chlh_jd!

This is a wonderful program!
You are an artist!
Only I can not use this great Lisp because I only work with polylines.

Would that also be used for polylines?

love greetings

Martin :-)

Peter2

  • Swamp Rat
  • Posts: 650
Re: Trim and Replace Line with One Pick
« Reply #11 on: September 19, 2013, 12:22:22 PM »
Here's another for you to mull over :)
.....
Thanks. Just what I needed ...
Peter

AutoCAD Map 3D 2023 German (so some technical terms will be badly retranslated to English)
BricsCAD V23

AcDbZombieEntity

  • Mosquito
  • Posts: 20
Re: Trim and Replace Line with One Pick
« Reply #12 on: September 20, 2013, 05:56:21 AM »
Quote
Only I can not use this great Lisp because I only work with polylines.


The same with me, i guess the other 99.9% too.

Pad

  • Bull Frog
  • Posts: 342
Re: Trim and Replace Line with One Pick
« Reply #13 on: September 20, 2013, 01:17:29 PM »
Hopefully this works correctly for polylines??
Its a modification to chlh_jd routine.

The problem was that polylines do not have a dxf 11 code for the second vertex, all vertex's are dxf 10, so a list has to be made.
I have just bolted on bits I have pinched from searching around.

Cheers
Pads

Code - Auto/Visual Lisp: [Select]
  1. ;;
  2. ;;CREDITS TO chlh_jd - http://www.theswamp.org/index.php?topic=40873.msg461337#msg461337
  3. ;;
  4. ;;20/09/13 Patrick Bourke 360geomatics.co.uk - modified to work with polylines
  5. ;;
  6.  
  7. (defun c:wt (/ e pt el l a b c p1 p2 p3 p4 p10 p11 oce pointlistb pointlistc)
  8.  
  9.  
  10.   ;;trim and add new line for trim-space
  11.   ;; by GSLS(SS) 2012-2-9
  12.   (defun dxf (a l)
  13.     (cdr (assoc a l))
  14.   )
  15.   (defun mindis-pt (l pt)
  16.     (car
  17.       (vl-sort l
  18.                (function (lambda (e1 e2)
  19.                            (< (distance pt e1) (distance pt e2))
  20.                          )
  21.                )
  22.       )
  23.     )
  24.   )
  25.   (setq oce (getvar "cmdecho"))
  26.   (setvar "cmdecho" 0)
  27.   (setq e (entlast))
  28.   (prompt "Select a line :")
  29.   (command "Trim" "")  
  30.   (while (setq pt (entsel "\nSelect a line :"))
  31.     (command pt)    
  32.     (if (not (eq e (entlast)))
  33.       (progn
  34.         (setq e (entlast)
  35.               b   (entget (car pt))
  36.               c   (entget e)
  37.               PointListb (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) b))
  38.               PointListc (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) c))
  39.               p1  (car PointListb)
  40.               p2  (cadr PointListb)
  41.               p3  (car PointListc)
  42.               p4  (cadr PointListc)
  43.               p11 (mindis-pt (list p3 p4) p1)
  44.               p10 (mindis-pt (list p1 p2) p3)
  45.         )
  46.         (entmake
  47.           (list (cons 0 "LINE")
  48.                 (cons 10 p10)
  49.                 (cons 11 p11)
  50.                 (cons 6 "DASHED");_LineType must be loaded
  51.                 (cons 62 251)
  52.           )
  53.         )
  54.         )
  55.       )    
  56.   )
  57.   (command "")
  58.  
  59.   (setvar "cmdecho" oce)
  60.   (princ)
  61. )
  62.  

martinle

  • Newt
  • Posts: 22
Re: Trim and Replace Line with One Pick
« Reply #14 on: September 23, 2013, 12:07:03 AM »
Hello pad!

It works very well with open polylines. But if I use it on closed polylines, it does not work. Why?

Greetings

Martin :-(