Topic: how to carry out the Copy Element?

[2e4lite]

    The following is Specific requirements: 
    Specify an element that you want to copy. Able to polyline part of the specified segment copied out, but also can choose other line or polyline to copy.Specify a base point for the target figure or enter the base point coordinate. Finally,specify a destination point.

[ribarm]

I didn't understand everything you asked, but for copying elements (segments) of polylines I have this code... Not fully tested, so please inform if something isn't as it should...

Code - Auto/Visual Lisp: [Select]

1. (defun c:C2P (/ *error* cmd ss pt pl ptpar pt1 pt2 pll)
2.  
3.   (vl-load-com)
4.  
5.   (defun *error* ( msg )
6.     (if cmd (setvar 'cmdecho cmd))
7.     (command "_.ucs" "p")
8.     (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
9.   )
10.  
11.   (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
12.   (command "_.ucs" "w")
13.   (setq cmd (getvar "CMDECHO"))
14.   (setvar "CMDECHO" 0)
15.  
16.   (if (and (not (prompt "\nSelect polyline to copy with touching"))
17.            (setq ss (ssget "_+.:S:L" '((0 . "LWPOLYLINE"))))
18.            (setq pt (cadr (cadddr (car (ssnamex ss 0)))))
19.            (setq pt (vlax-curve-getclosestpointto (setq pl (ssname ss 0)) pt))
20.            (setq ptpar (vlax-curve-getparamatpoint pl pt))
21.            (setq pt1 (vlax-curve-getpointatparam pl (float (fix ptpar))))
22.            (setq pt2 (vlax-curve-getpointatparam pl (float (fix (+ ptpar 1.0)))))
23.       )
24.       (progn
25.         (command "_.copy" pl "" '(0.0 0.0 0.0) '(0.0 0.0 0.0))
26.         (setq pll (entlast))
27.         (if (/= (float (fix ptpar)) 0.0)
28.           (progn
29.             (command "_.break" (car (nentselp pt)) pt1 pt1)
30.             (command "_.break" (car (nentselp pt)) pt2 pt2)
31.             (command "_.move" (entnext pll) "" pause pause)
32.             (entdel pll)
33.             (entdel (entnext (entnext pll)))
34.           )
35.           (progn
36.             (command "_.break" (car (nentselp pt)) pt1 pt1)
37.             (command "_.break" (car (nentselp pt)) pt2 pt2)
38.             (command "_.move" pll "" pause pause)
39.             (entdel (entnext pll))
40.           )
41.         )
42.       )
43.   )
44.   (*error* nil)
45.   (princ)
46. )
47.  

M.R.

[2e4lite]

     Thanks for your reply,I have tested your C2P.lsp.  The code is no error but not what I want. Firstly, I need it can selected in different pline segments. Secondly, it preferably with window or crossing selection mode (e.g. (command "._select" (ssget "C" xx yy) pause) ). Of course, also need sigle selection mode in processing.

[ribarm]

     Thanks for your reply,I have tested your C2P.lsp.  The code is no error but not what I want. Firstly, I need it can selected in different pline segments. Secondly, it preferably with window or crossing selection mode (e.g. (command "._select" (ssget "C" xx yy) pause) ). Of course, also need sigle selection mode in processing.

I can't follow you what do you request, but this is my revision of the code posted above... It should work and for old-heavy 2d polylines as well as 3d polylines... I thought you just wanted copying of pline segments...

Code - Auto/Visual Lisp: [Select]

1. (defun c:C2P (/ *adoc* *error* cmd ss pt pl ptpar pt1 pt2 pll)
2.  
3.   (vl-load-com)
4.   (setq *adoc* (vla-get-activedocument (vlax-get-acad-object)))
5.  
6.   (defun *error* ( msg )
7.     (if cmd (setvar 'cmdecho cmd))
8.     (command "_.ucs" "p")
9.     (vla-endundomark *adoc*)
10.   )
11.  
12.   (vla-startundomark *adoc*)
13.   (command "_.ucs" "w")
14.   (setq cmd (getvar "CMDECHO"))
15.   (setvar "CMDECHO" 0)
16.  
17.   (if (and (not (prompt "\nSelect polyline to copy with touching"))
18.            (setq ss (ssget "_+.:S:L" '((0 . "LWPOLYLINE,POLYLINE"))))
19.            (setq pt (cadr (cadddr (car (ssnamex ss 0)))))
20.            (setq pt (vlax-curve-getclosestpointto (setq pl (ssname ss 0)) pt))
21.            (setq ptpar (vlax-curve-getparamatpoint pl pt))
22.            (setq pt1 (vlax-curve-getpointatparam pl (float (fix ptpar))))
23.            (setq pt2 (vlax-curve-getpointatparam pl (float (fix (+ ptpar 1.0)))))
24.       )
25.       (progn
26.         (command "_.copy" pl "" '(0.0 0.0 0.0) '(0.0 0.0 0.0))
27.         (setq pll (entlast))
28.         (if (eq (cdr (assoc 0 (entget pl))) "LWPOLYLINE")
29.           (progn
30.             (if (/= (float (fix ptpar)) 0.0)
31.               (progn
32.                 (command "_.break" (car (nentselp pt)) (osnap pt1 "_end") (osnap pt1 "_end"))
33.                 (command "_.break" (car (nentselp pt)) (osnap pt2 "_end") (osnap pt2 "_end"))
34.                 (command "_.move" (entnext pll) "" pause pause)
35.                 (entdel pll)
36.                 (entdel (entnext (entnext pll)))
37.               )
38.               (progn
39.                 (command "_.break" (car (nentselp pt)) (osnap pt1 "_end") (osnap pt1 "_end"))
40.                 (command "_.break" (car (nentselp pt)) (osnap pt2 "_end") (osnap pt2 "_end"))
41.                 (command "_.move" pll "" pause pause)
42.                 (entdel (entnext pll))
43.               )
44.             )
45.           )
46.           (progn
47.             (if (and (/= (float (fix ptpar)) 0.0) (not (equal pt1 (vlax-curve-getendpoint pl) 1e-8)) (not (equal pt2 (vlax-curve-getendpoint pl) 1e-8)))
48.               (progn
49.                 (command "_.break" (car (nentselp pt)) (osnap pt1 "_end") (osnap pt1 "_end"))
50.                 (command "_.break" (car (nentselp pt)) (osnap pt2 "_end") (osnap pt2 "_end"))
51.                 (entdel (entlast))
52.                 (command "_.move" (car (nentselp pt)) "" pause pause)
53.                 (entdel (ssname (ssget "_X") 1))
54.               )
55.               (cond
56.                 ( (and (not (equal pt1 (vlax-curve-getendpoint pl) 1e-8)) (= (float (fix ptpar)) 0.0))
57.                   (progn
58.                     (command "_.break" (car (nentselp pt)) (osnap pt2 "_end") (osnap pt2 "_end"))
59.                     (entdel (entlast))
60.                     (command "_.move" (car (nentselp pt)) "" pause pause)
61.                   )
62.                 )
63.                 ( (equal pt1 (vlax-curve-getendpoint pl) 1e-8)
64.                   (progn
65.                     (command "_.break" (car (nentselp pt)) (osnap pt2 "_end") (osnap pt2 "_end"))
66.                     (entdel (entlast))
67.                     (command "_.move" (car (nentselp pt)) "" pause pause)
68.                   )
69.                 )
70.                 ( (equal pt2 (vlax-curve-getendpoint pl) 1e-8)
71.                   (progn
72.                     (command "_.break" (car (nentselp pt)) (osnap pt1 "_end") (osnap pt1 "_end"))
73.                     (entdel (ssname (ssget "_X") 1))
74.                     (command "_.move" (car (nentselp pt)) "" pause pause)
75.                   )
76.                 )
77.               )
78.             )
79.           )
80.         )
81.       )
82.   )
83.   (*error* nil)
84.   (princ)
85. )
86.  

M.R.

[Lee Mac]

Try the following quick draft:

Code - Auto/Visual Lisp: [Select]

1. ;; Copy LWPolyline Segment  -  Lee Mac
2. ;; Allows the user to copy a single selected LWPolyline segment, retaining all properties
3. ;; of the LWPolyline parent.
4. ;; Works under all UCS & View settings.
5.  
6. (defun c:cseg ( / *error* c e h l n s )
7.  
8.     (defun *error* ( msg )
9.         (if (= 'ename (type c)) (entdel c))
10.         (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
11.             (princ (strcat "\nError: " msg))
12.         )
13.         (princ)
14.     )
15.    
16.     (while
17.         (progn (setvar 'errno 0) (setq s (nentsel "\nSelect LWPolyline segment to copy: "))
18.             (cond
19.                 (   (= 7 (getvar 'errno))
20.                     (princ "\nMissed, try again.")
21.                 )
22.                 (   (vl-consp s)
23.                     (setq e (entget (car s)))
24.                     (cond
25.                         (   (/= "LWPOLYLINE" (cdr (assoc 0 e)))
26.                             (princ "\nObject is not an LWPolyline segment.")
27.                         )
28.                         (   (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (cdr (assoc 8 e)))))))
29.                             (princ "\nObject is on a locked layer.")
30.                         )
31.                         (   (cddr s)
32.                             (princ "\nObject is nested.")
33.                         )
34.                     )
35.                 )
36.             )
37.         )
38.     )
39.     (if s
40.         (progn
41.             (setq n (fix (vlax-curve-getparamatpoint (car s) (vlax-curve-getclosestpointto (car s) (trans (cadr s) 1 0))))
42.                   h (reverse (cons (assoc 210 e) (member (assoc 39 e) (reverse e))))
43.                   h (subst (cons 70 (boole 4 1 (cdr (assoc 70 h)))) (assoc 70 h) h)
44.                   h (subst '(90 . 2) (assoc 90 h) h)
45.                   l (LM:LWVertices e)
46.             )
47.             (if (= 1 (logand 1 (cdr (assoc 70 e))))
48.                 (setq l (append l (list (car l))))
49.             )
50.             (if (setq c (entmakex (append h (nth n l) (nth (1+ n) l))))
51.                 (progn
52.                     (command "_.move" c "")
53.                     (while (= 1 (logand 1 (getvar 'cmdactive))) (command "\\"))
54.                 )
55.                 (princ "\nUnable to generate polyline segment.")
56.             )
57.         )
58.     )
59.     (princ)
60. )
61.  
62. ;; LW Vertices  -  Lee Mac
63. ;; Returns a list of lists in which each sublist describes the position,
64. ;; starting width, ending width and bulge of a vertex of an LWPolyline
65.  
66. (defun LM:LWVertices ( e )
67.     (if (setq e (member (assoc 10 e) e))
68.         (cons
69.             (list
70.                 (assoc 10 e)
71.                 (assoc 40 e)
72.                 (assoc 41 e)
73.                 (assoc 42 e)
74.             )
75.             (LM:LWVertices (cdr e))
76.         )
77.     )
78. )
79.  
80. (vl-load-com) (princ)

[CAB]

     Thanks for your reply,I have tested your C2P.lsp.  The code is no error but not what I want. Firstly, I need it can selected in different pline segments. Secondly, it preferably with window or crossing selection mode (e.g. (command "._select" (ssget "C" xx yy) pause) ). Of course, also need sigle selection mode in processing.

Welcome to the Swamp.

Do you have any programing experience in LISP?

[2e4lite]

     In order to let you a deeper understanding of my request.The Gif format has been attached. in the animation, I can use the window selection and pickup selection method, the polyline segments and line entities are copied out. The methods and steps can be different with the animation, but to be able to achieve the same result very convenient.

[Lee Mac]

Looks like you either already possess such a program, or you want us to reverse engineer functionality offered by another program - either way, I'm out.