Apply layer of selected objects to crossing (touched) objects.

[asdfghjk02@gmx.com]

Hello to everyone here.

 

Can somebody help to make lisp which will apply layer of selected objects (2D polylines/3d polylines ) to crossing (touched) objects. 

Look at picture, *.gif - its packed in zip to be able upload here. 

I have searched through many forums and lisp databases but could not find anything like that.

 

Process:

1. select objects from different layers

2. lisp will automatically  (move crossing objects) to layer of selected objects

 

Thank you very much

example.zip

Edited March 10, 2020 by asdfghjk02@gmx.com

[f700es]

Their gif.....

[ronjonp]

Also posted HERE and HERE.

[Jonathan Handojo]

If you're only talking about polylines, then this will work for you

 

;; Escape Wildcards  -  Lee Mac
;; Escapes wildcard special characters in a supplied string
 
(defun LM:escapewildcards ( str )
    (vl-list->string
        (apply 'append
            (mapcar
               '(lambda ( c )
                    (if (member c '(35 64 46 42 63 126 91 93 45 44))
                        (list 96 c)
                        (list c)
                    )
                )
                (vl-string->list str)
            )
        )
    )
)

(defun JH:selset-to-list (selset / lst iter) ; Returns all entities within a selection set into a list.
  (setq iter 0)
  (repeat (sslength selset)
    (setq lst (cons (ssname selset iter) lst)
	  iter (1+ iter))
    )
  (reverse lst)
  )

(defun c:laytouch ( / *error* activeundo acadobj adoc msp df ex maxpt minpt objs pts ss)
  (defun *error* ( msg )
    (vla-EndUndoMark adoc)
    (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*"))
      (princ (strcat "Error: " msg))
      )
    )
  (setq acadobj (vlax-get-acad-object)
        adoc (vla-get-ActiveDocument acadobj)
        msp (vla-get-ModelSpace adoc)
        activeundo nil)
  (if (= 0 (logand 8 (getvar "UNDOCTL"))) (vla-StartUndoMark adoc) (setq activeundo T))

  (while (setq df (tblnext "layer" (not df)))	; <--- Finding layers that are locked, frozen, or off (Reference from Chain Selection by Lee Mac)
    (if
      (or
	(minusp (cdr (assoc 62 df)))
	(< 0 (logand 5 (cdr (assoc 70 df))))
	)
      (setq ex (cons (cons 8 (LM:escapewildcards (cdr (assoc 2 df)))) ex))
      )
    )	; <--- End reference.
  
  (setq ss (ssget ":L" '((0 . "*POLYLINE"))))
  (if ss
    (progn
      (foreach x (JH:selset-to-list ss)
	(setq pts (vl-remove nil
		    (append
		      (mapcar 'cdr (vl-remove-if-not '(lambda (y) (eq (car y) 10)) (entget x)))
		      (list (if (eq (cdr (assoc 70 (entget x))) 1) (cdr (assoc 10 (entget x)))))
		      )
		    )
	      )
	(vla-GetBoundingBox (vlax-ename->vla-object x) 'minpt 'maxpt)
	(vla-ZoomWindow acadobj minpt maxpt)
	(setq objs (ssget "_F" pts (if ex (append '((-4 . "<NOT") (-4 . "<OR")) ex '((-4 . "OR>") (-4 . "NOT>"))))))
	
	(vla-ZoomPrevious acadobj)
	(if objs
	  
	  (foreach y (JH:selset-to-list objs)
	    (entmod
	      (subst
		(cons 8 (cdr (assoc 8 (entget x))))
		(assoc 8 (entget y))
		(entget y)
		)
	      )
	    )
	  )
	)
      )
    )
  
  (if activeundo nil (vla-EndUndoMark adoc))
  (princ)
  )

 

[asdfghjk02@gmx.com]

Hello Jonathan

 

Yepp, polylines is what i use most. 

Yours Lisp works fine after first  test. 

I am very thanksfull for that. 

 

Thank you Jonathan. 

 

[asdfghjk02@gmx.com]

21 hours ago, ronjonp said:

Also posted HERE and HERE.

 

Hei Ronjonp

 

Solution for this post is solved by Jonathan,  I have linked those other forums with solution from Jonathan pointing on this forum ``Cadtutot.net``

 

 

[Akenaton]

Buenos días, sería muy complicado adaptar el lisp para que los objetos “origen” en vez de polilineas sean objetos “punto”?

 

good morning, it eould be very difficult to adapt the lisp so that the “origin” objects instead of polylines are “point” object

[BIGAL]

Post dwg before after.