mhy3sx Posted May 31, 2024 Posted May 31, 2024 Hi, I am trying to write a lisp to detect overlapping polylines on Layer1 and Layer2 and draw lines only to the overlap parts on Layer3 I attach a dwg to see exactly what I am talking about (defun c:test (/ ss ent1 ent2 intpt) (setq ss (ssget "_X" '((0 . "LWPOLYLINE")(8 . "LAyer1,Layer2")(410 . "Model")))) (if ss (progn (command "_.layiso" ss "") (command "_.layuniso" "_all") (setq ent1 (ssname ss 0)) (setq ent2 (ssname ss 1)) (setq intpt (vlax-curve-getclosestpointto ent1 ent2)) (if intpt (progn (if (assoc 10 (entget intpt)) (progn (command "_line" (cdr (assoc 10 (entget ent1))) (cdr (assoc 10 (entget intpt))) "") (command "_line" (cdr (assoc 10 (entget ent2))) (cdr (assoc 10 (entget intpt))) "") (command "_layer" "_m" "Layer3" "_c" "161" "" "") ) ) ) ) ) ) ) Drawing1.dwgFetching info... Quote
marko_ribar Posted May 31, 2024 Posted May 31, 2024 This worked for me : (defun c:overlapints2lines ( / ss s1 s2 i e x e1 e2 ii p1 p2 ) (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com)) (if (setq ss (ssget "_:L" (list (cons 8 "Layer1,Layer2")))) (progn (setq s1 (ssadd)) (setq s2 (ssadd)) (repeat (setq i (sslength ss)) (setq e (ssname ss (setq i (1- i)))) (setq x (entget e)) (if (= (strcase (cdr (assoc 8 x))) (strcase "Layer1")) (ssadd e s1) (ssadd e s2) ) ) (cond ( (= (sslength s1) 1) (setq e1 (ssname s1 0)) (foreach e2 (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex s2))) (setq ii (vlax-invoke (vlax-ename->vla-object e1) (quote intersectwith) (vlax-ename->vla-object e2) acextendnone)) (if (= (length ii) 6) (progn (setq p1 (list (car ii) (cadr ii) (caddr ii)) p2 (list (nth 3 ii) (nth 4 ii) (nth 5 ii))) (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2) (cons 8 "Layer3"))) ) ) ) ) ( (= (sslength s2) 1) (setq e2 (ssname s2 0)) (foreach e1 (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex s1))) (setq ii (vlax-invoke (vlax-ename->vla-object e2) (quote intersectwith) (vlax-ename->vla-object e1) acextendnone)) (if (= (length ii) 6) (progn (setq p1 (list (car ii) (cadr ii) (caddr ii)) p2 (list (nth 3 ii) (nth 4 ii) (nth 5 ii))) (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2) (cons 8 "Layer3"))) ) ) ) ) ) ) ) (princ) ) Regards, M.R. Quote
mhy3sx Posted May 31, 2024 Author Posted May 31, 2024 Hi marko_ribar. The code works fine, but I realized that if I use this code 2 or more times in the same drawing I have overlap lines in Layer3. Is it possible to add a filter , if on the overlap polyline parts the Layer3 line exist not draw other? Thanks Quote
marko_ribar Posted May 31, 2024 Posted May 31, 2024 (edited) Here, I've modified previous code slightly... Untested though, but it should work... (defun c:overlapints2lines ( / ss s1 s2 s3 i e x e1 e2 ii p1 p2 lst ) (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com)) (if (setq ss (ssget "_:L" (list (cons 8 "Layer1,Layer2,Layer3")))) (progn (setq s1 (ssadd)) (setq s2 (ssadd)) (setq s3 (ssadd)) (repeat (setq i (sslength ss)) (setq e (ssname ss (setq i (1- i)))) (setq x (entget e)) (cond ( (= (strcase (cdr (assoc 8 x))) (strcase "Layer1")) (ssadd e s1) ) ( (= (strcase (cdr (assoc 8 x))) (strcase "Layer2")) (ssadd e s2) ) ( (= (strcase (cdr (assoc 8 x))) (strcase "Layer3")) (ssadd e s3) ) ) ) (repeat (setq i (sslength s3)) (setq e (ssname s3 (setq i (1- i)))) (setq x (entget e)) (if (= (cdr (assoc 0 x)) "LINE") (setq lst (cons (cdr (assoc 10 x)) lst) lst (cons (cdr (assoc 11 x)) lst)) ) ) (foreach e1 (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex s1))) (foreach e2 (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex s2))) (setq ii (vlax-invoke (vlax-ename->vla-object e1) (quote intersectwith) (vlax-ename->vla-object e2) acextendnone)) (if (= (length ii) 6) (progn (setq p1 (list (car ii) (cadr ii) (caddr ii)) p2 (list (nth 3 ii) (nth 4 ii) (nth 5 ii))) (if (and (not (vl-position p1 lst)) (not (vl-position p2 lst))) (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2) (cons 8 "Layer3"))) ) ) ) ) ) ) ) (princ) ) Regards, M.R. Edited June 1, 2024 by marko_ribar Quote
mhy3sx Posted May 31, 2024 Author Posted May 31, 2024 Thanks for the update.I have one last question. The code works for only one Layer1 polyline and multy Layer2 polylines overlap. If I have more Layer1 polylines is it possible to work with one selection . I want to change this line (setq ss (ssget "_:L" (list (cons 8 "Layer1,Layer2,Layer3")))) with this (setq ss (ssget "_x" (list (cons 8 "Layer1,Layer2,Layer3")))) to work for multy set of polylines Layer1 and Layer2 Thanks Quote
marko_ribar Posted May 31, 2024 Posted May 31, 2024 No, "Layer1" must be with only single polyline, that's why (ssget "_:L" ...) to alow user to select only portion of drawing consisting of single polyline on Layer1... Quote
mhy3sx Posted May 31, 2024 Author Posted May 31, 2024 Is it possible to work for (setq ss (ssget "_x" (list (cons 8 "Layer1,Layer2,Layer3")))) Thanks Quote
marko_ribar Posted June 1, 2024 Posted June 1, 2024 (edited) Try routine now... You can changle "_:L" to "_A" if you wish, but I left it as it was before... After all it wasn't such a big mod. from me... I suppose you could figure this on your own... Regards, M.R. Edited June 1, 2024 by marko_ribar Quote
XDSoft Posted June 2, 2024 Posted June 2, 2024 LISP Use the Arx-AcGe Geometry library to find the overlap of two polylines - AutoLISP, Visual LISP & DCL - AutoCAD Forums (cadtutor.net) https://www.cadtutor.net/forum/topic/83579-lisp-use-the-arx-acge-geometry-library-to-find-the-overlap-of-two-polylines/#comment-637163 Quote
mhy3sx Posted June 3, 2024 Author Posted June 3, 2024 Hi, I am trying to updeate the code in the same idea to detect insede close polylines on Layer1 -> close polyline on Layer2 (inside or inside overlap to Layer1) and text inside Layer 1 on layer MY-TEXT. I attach a dwg to see exactly what I am talking about (defun c:TEST5 ( / ss s1 s2 s3 i e x e1 e2 ii p1 p2 lst ) (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com)) (setq ss (ssget "_A" (list (cons 8 "LAYER1,LAYER2,MY-TEXT")))) (progn (setq s1 (ssadd)) (setq s2 (ssadd)) (setq s3 (ssadd)) (repeat (setq i (sslength ss)) (setq e (ssname ss (setq i (1- i)))) (setq x (entget e)) (cond ( (= (strcase (cdr (assoc 8 x))) (strcase "LAYER1")) (ssadd e s1) ) ( (= (strcase (cdr (assoc 8 x))) (strcase "LAYER2")) (ssadd e s2) ) ( (= (strcase (cdr (assoc 8 x))) (strcase "MY-TEXT")) (ssadd e s3) ) ) ) (foreach e1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex s1))) (foreach e2 (vl-remove-if 'listp (mapcar 'cadr (ssnamex s2))) (foreach e3 (vl-remove-if 'listp (mapcar 'cadr (ssnamex s3))) (setq ii (vlax-invoke (vlax-ename->vla-object e1) 'intersectwith (vlax-ename->vla-object e2) acextendnone)) (if (= (length ii) 6) (progn (setq p1 (list (car ii) (cadr ii) (caddr ii)) p2 (list (nth 3 ii) (nth 4 ii) (nth 5 ii))) (if (and (not (vl-position p1 lst)) (not (vl-position p2 lst))) (progn (if (= (tblsearch "layer" "BLD") nil) (command "_layer" "_m" "BLD" "_c" "10" "" "") ) (entmod (subst (cons 8 "BLD") (assoc 8 (entget e2)) (entget e2))) (entmod (subst (cons 8 "BLD") (assoc 8 (entget e3)) (entget e3))) ) ) ) ) ) ) ) ) (princ) ) Can any one help ? Thanks Drawing1.dwgFetching info... Quote
mhy3sx Posted June 3, 2024 Author Posted June 3, 2024 I make a second try for the code but in the first example in the drawing the code work fine , in the second example not working select all layer 2 . I dont'know why. Can any one fix the code? (defun c:foo2 ( / ss s1 s2 s3 i e x e1 e2 ii p1 p2 lst inside? get-polyline-vertices) (or (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-get-acad-object nil))) (vl-load-com)) ;; Select all entities on the specified layers (setq ss (ssget "_A" (list (cons 8 "LAYER1,LAYER2,MY-TEXT")))) ;; Initialize selection sets for each layer (progn (setq s1 (ssadd)) (setq s2 (ssadd)) (setq s3 (ssadd)) ;; Iterate through the selection set and add entities to their respective layer selection set (repeat (setq i (sslength ss)) (setq e (ssname ss (setq i (1- i)))) (setq x (entget e)) (cond ((= (strcase (cdr (assoc 8 x))) "LAYER1") (ssadd e s1)) ((= (strcase (cdr (assoc 8 x))) "LAYER2") (ssadd e s2)) ((= (strcase (cdr (assoc 8 x))) "MY-TEXT") (ssadd e s3)) ) ) ;; Define a function to check if a point is inside a ccw polyline (defun inside? (pt pl / minx maxx miny maxy) ;; Calculate the bounding box of the polyline (setq minx (apply 'min (mapcar 'car pl))) (setq maxx (apply 'max (mapcar 'car pl))) (setq miny (apply 'min (mapcar 'cadr pl))) (setq maxy (apply 'max (mapcar 'cadr pl))) ;; Check if the point is within the bounding box (and (>= (car pt) minx) (<= (car pt) maxx) (>= (cadr pt) miny) (<= (cadr pt) maxy)) ) ;; Define a function to retrieve the vertices of a polyline (defun get-polyline-vertices (e / obj len inc pt pts) (setq obj (vlax-ename->vla-object e)) (setq len (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))) (setq inc 0.0) (setq pts '()) (while (<= inc len) (setq pt (vlax-curve-getPointAtDist obj inc)) (setq pts (cons pt pts)) (setq inc (+ inc (vlax-curve-getDistAtParam obj 1.0))) ) (reverse pts) ) ;; Process the entities on Layer1 (foreach e1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex s1))) ;; Get the vertices of the ccw polyline (setq pl (get-polyline-vertices e1)) ;; Process the entities on Layer2 (foreach e2 (vl-remove-if 'listp (mapcar 'cadr (ssnamex s2))) ;; Check if the polyline on Layer2 is inside or overlaps with the ccw polyline on Layer1 (if (inside? (vlax-curve-getStartPoint (vlax-ename->vla-object e2)) pl) ;; If inside or overlapping, change the layer to "BLD" (entmod (subst (cons 8 "BLD") (assoc 8 (entget e2)) (entget e2))) ) ) ;; Process the text entities on MY-TEXT (foreach e3 (vl-remove-if 'listp (mapcar 'cadr (ssnamex s3))) ;; Check if the text entity is inside the ccw polyline on Layer1 (if (inside? (cdr (assoc 10 (entget e3))) pl) ;; If inside, change the layer to "BLD" (entmod (subst (cons 8 "BLD") (assoc 8 (entget e3)) (entget e3))) ) ) ) ) (princ) ) Thanks Drawing1.dwgFetching info... Quote
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.