asdfghjk02@gmx.com Posted March 10, 2020 Share Posted March 10, 2020 (edited) 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 Quote Link to comment Share on other sites More sharing options...
f700es Posted March 10, 2020 Share Posted March 10, 2020 Their gif..... Quote Link to comment Share on other sites More sharing options...
ronjonp Posted March 10, 2020 Share Posted March 10, 2020 Also posted HERE and HERE. Quote Link to comment Share on other sites More sharing options...
Jonathan Handojo Posted March 10, 2020 Share Posted March 10, 2020 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) ) Quote Link to comment Share on other sites More sharing options...
asdfghjk02@gmx.com Posted March 11, 2020 Author Share Posted March 11, 2020 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. Quote Link to comment Share on other sites More sharing options...
asdfghjk02@gmx.com Posted March 11, 2020 Author Share Posted March 11, 2020 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`` Quote Link to comment Share on other sites More sharing options...
Akenaton Posted October 28, 2021 Share Posted October 28, 2021 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 Quote Link to comment Share on other sites More sharing options...
BIGAL Posted October 28, 2021 Share Posted October 28, 2021 Post dwg before after. Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.