TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: 2cook2 on February 07, 2012, 10:51:46 AM

Title: Trim and Replace Line with One Pick
Post by: 2cook2 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
Title: Re: Trim and Replace Line with One Pick
Post by: ronjonp 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
)
Title: Re: Trim and Replace Line with One Pick
Post by: efernal 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.  
Title: Re: Trim and Replace Line with One Pick
Post by: ronjonp 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)
)
Title: Re: Trim and Replace Line with One Pick
Post by: chlh_jd 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)
)
Title: Re: Trim and Replace Line with One Pick
Post by: chlh_jd 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)
)
Title: Re: Trim and Replace Line with One Pick
Post by: Ketxu on February 09, 2012, 11:09:33 AM
How about Curve :">
Title: Re: Trim and Replace Line with One Pick
Post by: Sam on February 10, 2012, 02:34:10 AM
dear sir chlh_jd

nice program


Title: Re: Trim and Replace Line with One Pick
Post by: chlh_jd on February 23, 2012, 01:20:06 PM
Quote from: Sam on February 10, 2012, 02:34:10 AM
dear sir chlh_jd

nice program



You're wellcome !
Title: Re: Trim and Replace Line with One Pick
Post by: chlh_jd on February 23, 2012, 01:21:52 PM
Quote from: Ketxu on February 09, 2012, 11:09:33 AM
How about Curve :">
I believe it can be extend to All Curve-types , recently have no time ; I'll try it later .
Title: Re: Trim and Replace Line with One Pick
Post by: martinle 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 :-)
Title: Re: Trim and Replace Line with One Pick
Post by: Peter2 on September 19, 2013, 12:22:22 PM
Quote from: ronjonp on February 07, 2012, 12:55:35 PM
Here's another for you to mull over :)
.....
Thanks. Just what I needed ...
Title: Re: Trim and Replace Line with One Pick
Post by: AcDbZombieEntity 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.
Title: Re: Trim and Replace Line with One Pick
Post by: Pad 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.  
Title: Re: Trim and Replace Line with One Pick
Post by: martinle 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 :-(
Title: Re: Trim and Replace Line with One Pick
Post by: Pad on September 26, 2013, 09:38:17 AM
I cant get it to work on closed polylines

but let me know if this works any better:

Code - Auto/Visual Lisp: [Select]
  1. ;;
  2. ;;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. ;(defun c:wt (/)
  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  (car (reverse PointListb))
  41.               p3  (car PointListc)
  42.               p4  (car (reverse 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.         (entmake
  56.           (list (cons 0 "LINE") ;***
  57.                 (cons 6 "BYLAYER")
  58.                 (cons 8 "Walls")
  59.                 (cons 10 p2) ;***
  60.                 (cons 11 p3) ;***
  61.                 (cons 39 0.0)
  62.                 (cons 210 (list 0.0 0.0 1.0))
  63.           )
  64.         )
  65.         )
  66.       )    
  67.   )
  68.   (command "")
  69.  
  70.   (setvar "cmdecho" oce)
  71.   (princ)
  72. )
Title: Re: Trim and Replace Line with One Pick
Post by: martinle on September 27, 2013, 12:26:09 AM
Hello pad!

Thanks for your help.
It works with the neck of the polyline. There is no line, but then pulled the Dashed linetype.
Why is that?

Greetings Martin
Title: Re: Trim and Replace Line with One Pick
Post by: Pad on September 27, 2013, 12:56:19 PM
for the dashed line type just change lines 46 to 62 to this:

Code - Auto/Visual Lisp: [Select]
  2.   (list (cons 0 "LINE")
  3.  (cons 10 p10)
  4.  (cons 11 p11)
  5.  (cons 6 "DASHED");_LineType must be loaded
  6.  (cons 62 251)
  7.  
  8.  
  9.  
  10. ;       (entmake
  11. ;        (list (cons 0 "LINE") ;***
  12. ;               (cons 6 "BYLAYER")
  13. ;               (cons 8 "Walls")
  14. ;               (cons 10 p2) ;***
  15. ;               (cons 11 p3) ;***
  16. ;               (cons 39 0.0)
  17. ;              (cons 210 (list 0.0 0.0 1.0))
Title: Re: Trim and Replace Line with One Pick
Post by: Peter2 on January 13, 2014, 09:54:55 AM
Quote from: Pad on September 26, 2013, 09:38:17 AM

Code - Auto/Visual Lisp: [Select]
  1. ;;
  2. ...
  3.               PointListb (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) b))
  4.               PointListc (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) c))
  5. ...
  6.  
Hi Patrick
at the moment I have no idea what's the algorithm behind these lines. If you have a little bit of time it would be great if you add some comments to your code  :-D

Thanks
Title: Re: Trim and Replace Line with One Pick
Post by: Lee Mac on January 14, 2014, 03:44:34 PM
Quote from: Peter2 on January 13, 2014, 09:54:55 AM
Quote from: Pad on September 26, 2013, 09:38:17 AM
Code - Auto/Visual Lisp: [Select]
  1.               PointListb (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) b))
  2.               PointListc (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) c))
If you have a little bit of time it would be great if you add some comments to your code  :-D

Assuming variables 'b' & 'c' point to DXF data for an LWPolyline entity, the above expressions will return a list of vertices for the polylines described by the supplied DXF data lists.

You can see this by stepping through the expressions one expression at a time:

In the following example, assume that the variable 'elist' contains the following LWPolyline DXF data:
Code - Auto/Visual Lisp: [Select]
  1. (
  2.   (-1 . <Entity name: 7ef03b88>)
  3.   (0 . "LWPOLYLINE")
  4.   (330 . <Entity name: 7ef01cf8>)
  5.   (5 . "359")
  6.   (100 . "AcDbEntity")
  7.   (67 . 0)
  8.   (410 . "Model")
  9.   (8 . "0")
  10.   (100 . "AcDbPolyline")
  11.   (90 . 4)
  12.   (70 . 0)
  13.   (43 . 0.0)
  14.   (38 . 0.0)
  15.   (39 . 0.0)
  16.   (10 17.3428 14.1773)
  17.   (40 . 0.0)
  18.   (41 . 0.0)
  19.   (42 . 0.0)
  20.   (91 . 0)
  21.   (10 19.951 16.9304)
  22.   (40 . 0.0)
  23.   (41 . 0.0)
  24.   (42 . 0.0)
  25.   (91 . 0)
  26.   (10 23.6196 14.0079)
  27.   (40 . 0.0)
  28.   (41 . 0.0)
  29.   (42 . 0.0)
  30.   (91 . 0)
  31.   (10 26.652 17.0151)
  32.   (40 . 0.0)
  33.   (41 . 0.0)
  34.   (42 . 0.0)
  35.   (91 . 0)
  36.   (210 0.0 0.0 1.0)
  37. )

Evaluating the vl-remove-if-not expression leaves only the DXF group 10 entries (you can read this literally from the expression: "remove if the first element of each list item is not equal to 10"):
Code - Auto/Visual Lisp: [Select]
  1. _$ (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) elist)
  2. (
  3.   (10 17.3428 14.1773)
  4.   (10 19.951 16.9304)
  5.   (10 23.6196 14.0079)
  6.   (10 26.652 17.0151)
  7. )

Now, the mapcar expression evaluates the cdr function on each of these DXF group 10 items, returning each list with the first item (the DXF group code) removed, thus returning the vertex coordinates:
Code - Auto/Visual Lisp: [Select]
  1. _$ (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) elist))
  2. (
  3.   (17.3428 14.1773)
  4.   (19.951 16.9304)
  5.   (23.6196 14.0079)
  6.   (26.652 17.0151)
  7. )
Title: Re: Trim and Replace Line with One Pick
Post by: Peter2 on January 16, 2014, 01:24:28 PM
Thanks Lee

now I have a good base to study it (and later the rest of the code ..).
Title: Re: Trim and Replace Line with One Pick
Post by: Lee Mac on January 16, 2014, 06:07:16 PM
Quote from: Peter2 on January 16, 2014, 01:24:28 PM
Thanks Lee

now I have a good base to study it (and later the rest of the code ..).

Excellent - you're welcome  :-)