Leaderboard

Attached is lisp to handle both cw and ccw lwpolylines Bearing_and_DistancePolyH.lsp

thank you dlanorh thank you BIGAL this is wonderful code Thank you very much

example : (vla-put-color obj AcRed) ; or index 1 updated with progn

perhaps TEXT string invalid for symbol table? or formatted MTEXT? example: <TEST-00 TEST-01> TEST:02 TEST 03*10 TEST 04,05 TEST-05? TEST=06 TEST|07 TEST-08/08 TEST-09\\P10 use snvalid to validate (defun c:tt (/ $ ok str doc lays ss) (and (ssget "_:L" '((0 . "*TEXT"))) (vlax-for obj (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)) lays (vla-get-layers (vla-get-Database doc )) ss (vla-get-ActiveSelectionSet doc)) (setq str (vla-get-TextString obj) $ str ) (if (and (setq ok (snvalid str)) (not (tblsearch "LAYER" str)) (not (tblsearch "LAYER" (setq $ (strcat "A-_" str "-N")))) ) (progn (vla-add lays $) (princ (strcat "\nNew layer created : " $)) ) (princ (if (not ok) "\nInvalid name! " (strcat "\nLayer exists : " $) ) ) ) (progn (vla-put-layer obj $) (vla-put-color obj AcRed) ); change to new layer ) ) (vl-catch-all-apply 'vlax-release-object (list ss)) (princ) )

I don't know what the OP wants, as once again I can't open his attached drawing. This also looks like a continuation of the previous topic, in which case there are easier ways to achieve what he wants.

I use Gile's code alot, but prefer to use the offset method for closed polylines, as you can construct a ccw polygon where the first half reports as clockwise (crescent shape). I just haven't had a chance to update the other parts of the routine where the azimuths will fill the opposite string.

dlanorh I was having problem with angle 0.0 draw a rectang, (> azi 0.0) what about 0.0 in cond, good idea using vlax-curve. ;simple clock wise test by Gile (defun gc:clockwise-p ( p1 p2 p3 ) (< (sin (- (angle p1 p3) (angle p1 p2))) -1e-14))

dlanorh wants group of numbers not all. no + on end. Try this, note 1 will not work but can be added if required. How many in groups to be added 5 7.394 + 44.454 + 40.050 + 22.976 + 17.886 15.146 + 11.826 + 75.878 How many in groups to be added 4 7.394 + 44.454 + 40.050 + 22.976 17.886 + 15.146 + 11.826 + 75.878 How many in groups to be added 3 7.394 + 44.454 + 40.050 22.976 + 17.886 + 15.146 11.826 + 75.878 (setq AL '("7.394" "44.454" "40.050" "22.976" "17.886" "15.146" "11.826" "75.878")) (defun c:lstmtxt ( / x inc y txt diff pt1 pt2 howmany) (setq x (length al)) (setq inc (getint "\nHow many in groups to be added ")) (if (> inc x)(setq inc x)) (setq y -1 txt "") (repeat (setq howmany (fix (/ x inc))) (repeat (- inc 1) (setq txt (strcat txt (nth (setq y (+ y 1)) al) " + ")) ) (setq txt (strcat txt (nth (setq y (+ y 1)) al) (chr 10))) ) (setq diff (- x (* howmany inc))) (if (> diff 0) (progn (repeat (- diff 1) (setq txt (strcat txt (nth (setq y (+ y 1)) al) " + ")) ) (setq txt (strcat txt (nth (setq y (+ y 1)) al))) ) ) (setq pt1 (getpoint "\nPick point for top left Mtext ")) (setq pt2 (getpoint pt1 "\nPick point for bottom right Mtext ")) (command "mtext" pt1 pt2 txt "") (princ) ) (c:lstmtxt)

Use this @Lee Mac function (defun LM:lst->str ( lst del / str ) (setq str (car lst)) (foreach itm (cdr lst) (setq str (strcat str del itm))) str ) ;(LM:lst->str AL " + ") => "7.394 + 44.454 + 40.050 + 22.976 + 17.886 + 15.146 + 11.826 + 75.878"

@hosneyalaa Attached is attempt so far. This only works for clockwise polylines at present but I should be able to incorporate ccw polylines tomorrow. Hope this is what you're after. Bearing_and_DistancePolyH.lsp

For me pick point, use ssget "F" actually a polygon keep increasing till ssget find 2 circles then like marko use TTR with random radius. The approx. tan point is circle cen to picked point intersection. Interesting idea have done a few random patterns including a 3d tree ball of leaves. Try this includes 1st 2 circles, note it seems to work as it tries to find only 2 circles so if it misses keeps going no real check for after 50. Circles should be radius 1 to 30. Big circle be a little away small up closer. Note the Briscad polygon difference, need to find the check what am I running know about product key but Briscad does not like something when using it. ;; Rand - Lee Mac ;; PRNG implementing a linear congruential generator with ;; parameters derived from the book 'Numerical Recipes' (defun LM:rand ( / a c m ) (setq m 4294967296.0 a 1664525.0 c 1013904223.0 $xn (rem (+ c (* a (cond ($xn) ((getvar 'date))))) m) ) (/ $xn m) ) (defun LM:randrange (a b) (+ (min a b) (* (LM:rand) (abs (- a b)))) ) ; Adds a random radius circle berween 2 existing circles. ; By AlanH March 2020 info@alanh.com.au (defun c:3rdcirc (/ pt obj1 obj2 obj3 inc cen intpt1 intpt2 rad ss) (vl-load-com) (setq rad (fix (1+ (LM:randrange 1 30)))) (command "circle" (getpoint "\pick point for 1st circle") rad) (command "circle" (getpoint "\pick point for 2nd circle") rad) (while (setq pt (getpoint "\npick a point Enter to exit")) (setq inc 1.0) (setq rad (fix (1+ (LM:randrange 1 30)))) (while (< inc 50) (command "polygon" 20 pt "I" inc) ; Autocad ; (command "polygon" 20 pt (polar pt 0.0 inc)) ; Briscad (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (entlast))))) (setq ss (ssget "F" co-ord (list (cons 0 "circle")))) (if (and (/= ss nil) (= (sslength ss) 2)) (progn (setq inc 51) (command "erase" (entlast) "") (setq obj1 (vlax-ename->vla-object (ssname ss 0))) (setq cen (vlax-get Obj1 'Center)) (command "line" cen pt "") (setq obj3 (vlax-ename->vla-object (entlast))) (setq intpt1 (vlax-invoke obj3 'intersectWith obj1 acExtendNone)) (command "erase" (entlast) "") (setq obj2 (vlax-ename->vla-object (ssname ss 1))) (setq cen (vlax-get Obj2 'Center)) (command "line" cen pt "") (setq obj3 (vlax-ename->vla-object (entlast))) (setq intpt2 (vlax-invoke obj3 'intersectWith obj2 acExtendNone)) (command "erase" (entlast) "") (command "circle" "TTR" intpt1 intpt2 Rad) ) (progn (setq inc (+ inc 1.0)) (command "erase" (entlast) "") ) ) ) ) (princ) ) (c:3rdcirc)

Here in attachment is something I revised recently... Take a look at the code, it also deals with circles tangents, but in various combinations of LINE, CIRCLE and POINT as reference objects... Look at Lee's ci1xci2 sub (trans) version that I slightly modified - I would use that sub instead of your version... Link : http://www.theswamp.org/index.php?topic=39567.msg449135#msg449135 HTH., M.R. (Also worth noting : There is command CIRCLE - 3p (tan, tan, tan) or CIRCLE - TTR (tan, tan, radius))...

Another one here. It's single pick but will keep the polyline intact.

I didn't thought you'd be doing that. I simply thought it was just an arc. A better way to approach that is if you select all lines or curves) that "goes below" (or doesn't change), then select the one polyline to curve or "go above" as shown in your desired result. With the help of LM:intersectionbetweensets by Lee Mac, this can be accomplished as shown in the gif below Assuming that the "purple" lines doesn't go too close the vertex of the polyline to "go above", the code to do as such is below: ;; Intersections Between Sets - Lee Mac ;; Returns a list of all points of intersection between objects in two selection sets. ;; ss1,ss2 - [sel] Selection sets (defun LM:intersectionsbetweensets ( ss1 ss2 / id1 id2 ob1 ob2 rtn ) (repeat (setq id1 (sslength ss1)) (setq ob1 (vlax-ename->vla-object (ssname ss1 (setq id1 (1- id1))))) (repeat (setq id2 (sslength ss2)) (setq ob2 (vlax-ename->vla-object (ssname ss2 (setq id2 (1- id2)))) rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn) ) ) ) (apply 'append (reverse rtn)) ) ;; Intersections - Lee Mac ;; Returns a list of all points of intersection between two objects ;; for the given intersection mode. ;; ob1,ob2 - [vla] VLA-Objects ;; mod - [int] acextendoption enum of intersectwith method (defun LM:intersections ( ob1 ob2 mod / lst rtn ) (if (and (vlax-method-applicable-p ob1 'intersectwith) (vlax-method-applicable-p ob2 'intersectwith) (setq lst (vlax-invoke ob1 'intersectwith ob2 mod)) ) (repeat (/ (length lst) 3) (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn) lst (cdddr lst) ) ) ) (reverse rtn) ) (defun c:linearc ( / *error* above activeundo acadobj adoc ang arc below msp rad) (defun *error* ( msg ) (setvar "CMDECHO" cmd) (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)) (princ "\nSelect curves that goes below: ") (if (setq cmd (getvar "CMDECHO") below (ssget '((0 . "LINE,*POLYLINE,CIRCLE,ARC,ELLIPSE,SPLINE"))) ) (progn (setq rad (progn (initget 1) (getreal "\nSpecify radius of arc: "))) (while (progn (setq above (entsel "\nSelect curve that goes above: ")) (cond ((null above) (princ "\nNothing selected")) ((not (wcmatch (cdr (assoc 0 (entget (car above)))) "LINE,*POLYLINE,CIRCLE,ARC,ELLIPSE,SPLINE")) (princ "\nObject is not a curve") ) ((setq above (car above)) nil) ) ) ) (setvar "CMDECHO" 0) (foreach x (vl-sort (LM:intersectionsbetweensets below (ssadd above)) '(lambda (a b) (< (vlax-curve-getParamAtPoint above a) (vlax-curve-getParamAtPoint above b) ) ) ) (if (< (* 0.5 pi) (setq ang (angle '(0 0 0) (vlax-curve-getFirstDeriv above (vlax-curve-getParamAtPoint above x)))) (* 1.5 pi) ) (setq ang (+ pi ang)) ) (setq arc (entmakex (list '(0 . "ARC") (cons 10 x) (cons 40 rad) (cons 50 ang) (cons 51 (+ pi ang)) ) ) ) (command "_break" above (polar x ang rad) (polar x (+ pi ang) rad)) (setq above (entnext arc)) ) (setvar "CMDECHO" cmd) ) ) (if activeundo nil (vla-EndUndoMark adoc)) (princ) ) The arc is drawn under the assumption that the intersection point is a straight line, and thus the angle between the arc is 180. If you were to select it on a circle, you'll notice that the arc and line won't be in line, but I think this will be quite enough with what you need to achieve. Thanks, Jonathan Handojo

I enjoy writing the programs and figure they are useless just sitting on my hard drive...