All Activity

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

I have such a lisp, prepared by master Alimuna. But it doesn't work exactly as I want. (defun c:test (/ dc ss ln lm e k s0 ts t0 tn tp ld ls) (vl-load-com) (if (and (setq dc (vla-get-ActiveDocument (vlax-get-acad-object)) ss (ssget '((0 . "LwPolyline") (8 . "GLine")))) (setq ln (getstring T "\nEnter the layer name:"))) (progn (vla-StartUndomark dc) (repeat (setq k (sslength ss)) (setq k (1- k) s0 (ssname ss k) ts (ssget "_X" '((0 . "*Text") (8 . "GText"))) ls nil) (repeat (setq e (sslength ts)) (setq e (1- e) t0 (ssname ts e) tn (entget t0) tp (cdr (assoc 10 tn)) ls (cons (list (distance tp (vlax-curve-getClosestPointTo (vlax-ename->vla-object s0) tp T)) tp (atof (getpropertyvalue t0 (if (= (cdr (assoc 0 tn)) "MTEXT") "Text" "TextString"))) t0) ls)) ) (setq ld (car (vl-sort ls '(lambda(a b) (< (car a) (car b))))) lm (if (= ln "") (getvar "Clayer") ln) tm (entget (nth 3 ld))) (entmake (list '(0 . "Point") (cons 8 lm) (cons 10 (append (cadar (vl-sort (mapcar '(lambda(a) (list (distance (cadr ld) a) a)) (mapcar 'cdr (vl-remove-if '(lambda(x) (/= (car x) 10)) (entget s0)))) '(lambda(a b) (> (car a) (car b))))) (list (caddr ld)))))) (entmod (subst (cons 8 lm) (assoc 8 tm) tm)) ) (vla-EndUndomark dc) ) ) (prin1) )

Check all your command line's need to have space between variables and "quotes" ;bad (command _trim"" ssdl1 ssdl"" "f" c1 c2"") ;good (command _trim "" ssdl1 ssdl "" "f" c1 c2 "") space space space I counted about 5 lines that need space --edit Its also a good idea to add "_non" when feeding points into command line because they do snap to entity's that are close depending on zoom level. even if osnap is toggled off. (command "line" "_non" p1 "_non" p2 "") --edit -- edit just looked at the code a bit more and move all the creating of the blank selection sets outside of the loop you only need to do that once. and it might clear out the selection set.

Thanks marko_ribar

(defun c:maahee () (setq p1 (getpoint "\nEnter start point: ")) (setq p2 (getpoint p1 "\nSelect second point: ")) (setq dist (getint "\nEnter number: ")) (setq inc (/ (distance p1 p2) dist)) (setq i 0) (while (<= i dist) (setq stpt-b (polar p1 (angle p1 p2) (* i inc))) (setq stpt-f (polar p1 (angle p1 p2) (+ (* i inc) 0.5))) (setq vertpt-b (polar stpt-b (+ (/ pi 2) (angle p1 p2)) 2.00)) (setq vertpt-f (polar stpt-f (+ (/ pi 2) (angle p1 p2)) 2.00)) (setq ssdl1 (ssadd)) ; create blank / empty selection set (command "line" stpt-b vertpt-b"") ;; Draw the connect point (ssadd (entlast) ssdl1) (setq ssdl (ssadd)) ; create blank / empty selection set (command "line" stpt-f vertpt-f"") ;; Draw the connect point (ssadd (entlast) ssdl) (setq ss1 (ssadd)) ; create blank / empty selection set (command "line"p1 p2"") (ssadd (entlast) ss1) (command "_.offset" 2 ss1 vertpt-f"") (setq c1 (polar stpt-b (angle p1 p2) 0.25)) (setq c2 (polar vertpt-b (angle p1 p2) 0.25)) (command _trim"" ssdl1 ssdl"" "f" c1 c2"") (setq i (+ i 1)) ) ) Trim function not work in loop (command _trim"" ssdl1 ssdl"" "f" c1 c2"") please help for solve issue

I select one Alignment and then select similar but all alignments selected (ssget (list (cons 0 "AECC_ALIGNMENT"))) I need to filter the selection to (Centerline Alignments only )

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.

Depends where you are in the world here in AUS its Ch 1234.45. Postal addresses in remote areas on roads are like 1092 meaning 10920 m from a start point.

In my case unit is feet. So the result I wanted and code written by @exceedmatches.

Bit busy but get all the text then do bounding box plus a small offset, then look for pline touching box, then add a Point. Some one else my jump in.

@Noor-Cad I didn't understand that in your short post and it wasn't in the original request for the program. This can be done, but you'll have to wait until I have some more time. Of course you could try to learn from it and add to the code yourself. That is, after all, what this forum is for.

Is it possible to work for (setq ss (ssget "_x" (list (cons 8 "Layer1,Layer2,Layer3")))) Thanks

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...

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

Thanks Steven, This is doing good, Can you please update this to work on 3dpolylines also and next request is to avoid repeatedly adding the suffix if the suffix is already added to the layer or change the color of the selected objects to avoid repeating of the same objects.

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.

Thanks Mr. Pkenewell, Its creating the layers but not shifting the points or objects.

Dear Exceed, I appreciate your efforts and contribution but doubt the use of this code. Normally in station values, any number before the + sign is considered a Kilometer, and after that 3 places as meters and then a point with 2 or 3 decimal digits. Now as per your definition, "So 0+48 added with +1000 should be 10+48" if 1000 or 1 Km is added to 48 or 480 meters it gives the result as "10+48" i.e, 10 Km and 48m whereas the correct answer should be 1+048 or 1+480 or 1+480.00 or 1.048.00. Correct me if I am Wrong

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

This LISP routine is great - thanks for sharing! I was wondering if you can modify it to use a specific radius when extending from the line's endpoint instead of it being a random radius drawn tangent to the line?

Good day Gentlemen, I need a LISP like this, Add a new Point to the end of the Polyline near MText/Text I have attached dwg example file Could you please help me with this? Point to Text-Polyline.dwg

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.

Spammer removed. I was already suspicious of them.

@BIGAL I have prepared one sample dwg template and excel to try your program on. In lisp program you have given, I am not able to perfectly map program to changes according to my need. If you can provide some instruction where I can change accordingly, I will do it. Thanks a lot for your efforts. Metadata.xlsx Trial.dwg

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.dwg