4o4osan Posted October 18, 2016 Share Posted October 18, 2016 Hello, hope that someone can help me with my request. I want to draw a polyline over circle using 4 parameters. Basically the user should specify the center of the circle (1) , the radius of the circle (2),the offset distance between the lines (3) and the distance to the turnaround point (4). I am able to convert most of my ideas into lisps, but with this one I will need some guide lines. I know that it is pure math but I do not know how to express it with code of intersection points, lines, offsets... Quote Link to comment Share on other sites More sharing options...
BIGAL Posted October 19, 2016 Share Posted October 19, 2016 Its doable nothing on the shelf 1st go take top quadrant pt draw a line horizontal offset down dia / number then use intersectwith to calc new pt offset down go reverse direction intersectwith and so on. 2nd go, line is tangential any angle same result. Thinking a bit more actually need like a 2 defuns run in sequence left & right as they are two lines apart. The multiple will always be (dia/num)*2 +1 for left start right end. You have center therefore know quadrant via simple polar need to just keep track of point swapping p1=p8 p2=p5 and so on. When I do something like this I get a bit of paper and draw object with pt numbers on it so I can keep track adding as I create then the repetition will become obvious. ; look at this as a starting example of intersect with (setvar "osmode" 512) ; nearest make sure on line (setq pickobj (entsel "\nPick arc :")) (setq obj1 (vlax-ename->vla-object (car pickobj))) (setq pickobj1 (entsel "\nPick 1st line :")) (setq obj2 (vlax-ename->vla-object (car pickobj1))) (setq intpt1 (vlax-invoke obj2 'intersectWith obj1 acExtendThisEntity)) Quote Link to comment Share on other sites More sharing options...
marko_ribar Posted October 22, 2016 Share Posted October 22, 2016 (edited) Here is my version with bulges - arcs... (defun c:snakeovercircle ( / *error* *adoc* el ci ce r n c d p k p1 p2 pl bl ) (vl-load-com) (defun *error* ( m ) (vla-endundomark *adoc*) (if m (prompt m) ) (princ) ) (vla-startundomark (setq *adoc* (vla-get-activedocument (vlax-get-acad-object)))) (setq el (entlast)) (prompt "\nPick or specify point to create snake over circle : ") (command "_.CIRCLE") (while (< 0 (getvar 'cmdactive)) (command "\\") ) (if (not (eq el (entlast))) (progn (setq ci (entlast)) (setq ce (cdr (assoc 10 (entget ci)))) (setq r (cdr (assoc 40 (entget ci)))) (initget 7) (setq n (getint "\nSpecify number of double turns : ")) (initget 1 "Yes No") (setq c (getkword "\nAdditional middle turn [Yes/No] : ")) (if (= c "Yes") (progn (setq d (/ (* 2 r) (1+ (* 2 n)))) (setq p (list (+ (car ce) r) (- (cadr ce) r))) (setq pl (cons p pl)) (setq k -1) (repeat n (setq k (1+ k)) (setq p1 (polar (list (car ce) (+ (- (cadr ce) r) (* k d))) (* (1+ k) pi) (sqrt (- (expt r 2) (expt (- r (* (1+ k) d)) 2))))) (setq p2 (polar p1 (* 0.5 pi) d)) (setq pl (cons p1 pl) pl (cons p2 pl)) ) (setq p (polar (list (car ce) (cadr p2)) (if (= (rem n 2) 0) pi 0.0) (sqrt (- (expt r 2) (expt (/ d 2) 2))))) (setq pl (cons p pl)) (setq p (polar p (* 0.5 pi) d)) (setq pl (cons p pl)) (setq k -1) (repeat n (setq k (1+ k)) (setq p1 (polar (list (car ce) (+ (cadr ce) (* k d) (/ d 2))) (* (+ n k) pi) (sqrt (- (expt r 2) (expt (* (+ k 0.5) d) 2))))) (setq p2 (polar p1 (* 0.5 pi) d)) (setq pl (cons p1 pl) pl (cons p2 pl)) ) (setq p (list (+ (car ce) r) (+ (cadr ce) r))) (setq pl (cons p pl)) (setq pl (reverse pl)) (setq bl (cons 0.0 bl)) (setq k -1) (repeat (- (length pl) 2) (setq k (1+ k)) (if (= (rem k 2) 0) (setq bl (cons 0.0 bl)) (setq bl (if (zerop (apply '+ bl)) (cons -1.0 bl) (cons 1.0 bl))) ) ) (setq bl (cons 0.0 bl)) ) (progn (setq d (/ r n)) (setq p (list (+ (car ce) r) (- (cadr ce) r))) (setq pl (cons p pl)) (setq k -1) (repeat n (setq k (1+ k)) (setq p1 (polar (list (car ce) (+ (- (cadr ce) r) (* k d))) (* (1+ k) pi) (sqrt (- (expt r 2) (expt (- r (* (1+ k) d)) 2))))) (setq p2 (polar p1 (* 0.5 pi) d)) (setq pl (cons p1 pl) pl (cons p2 pl)) ) (setq k -1) (repeat n (setq k (1+ k)) (setq p1 (polar (list (car ce) (+ (cadr ce) (* k d))) (* (+ n (1+ k)) pi) (sqrt (- (expt r 2) (expt (* k d) 2))))) (setq p2 (polar p1 (* 0.5 pi) d)) (setq pl (cons p1 pl) pl (cons p2 pl)) ) (setq p (list (- (car ce) r) (+ (cadr ce) r))) (setq pl (cons p pl)) (setq pl (reverse pl)) (setq bl (cons 0.0 bl)) (setq k -1) (repeat (- (length pl) 2) (setq k (1+ k)) (if (= (rem k 2) 0) (setq bl (cons 0.0 bl)) (setq bl (if (zerop (apply '+ bl)) (cons 1.0 bl) (cons -1.0 bl))) ) ) (setq bl (cons 0.0 bl)) ) ) (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length pl)) (cons 70 (if (= (getvar 'plinegen) 1) 128 0)) (cons 38 (caddr (cdr (assoc 10 (entget ci))))) ) (apply 'append (mapcar '(lambda ( a b ) (list (cons 10 a) (cons 42 b))) pl bl)) (list (assoc 210 (entget ci))) (list '(62 . 3)) ) ) ) ) (*error* nil) ) HTH, M.R. Edited May 2 by marko_ribar 1 Quote Link to comment Share on other sites More sharing options...
marko_ribar Posted October 23, 2016 Share Posted October 23, 2016 (edited) Here is version for ellipse... (defun c:snakeoverellipse ( / *error* *adoc* el orth ell ce r1 r2 n c d p k p1 p2 pl bl ) (vl-load-com) (defun *error* ( m ) (if orth (setvar 'orthomode orth) ) (vla-endundomark *adoc*) (if m (prompt m) ) (princ) ) (vla-startundomark (setq *adoc* (vla-get-activedocument (vlax-get-acad-object)))) (setq el (entlast)) (setq orth (getvar 'orthomode)) (setvar 'orthomode 1) (prompt "\nPick or specify point to create snake over ellipse - when draw mode of ELLIPSE firstly create X axis radius and then Y axis radius : ") (command "_.ELLIPSE" "_C") (while (< 0 (getvar 'cmdactive)) (command "\\") ) (if (not (eq el (entlast))) (progn (setq ell (entlast)) (setq ce (trans (cdr (assoc 10 (entget ell))) 0 1)) (setq r1 (abs (apply '+ (trans (cdr (assoc 11 (entget ell))) 0 (cdr (assoc 210 (entget ell))))))) (setq r2 (* r1 (cdr (assoc 40 (entget ell))))) (initget 7) (setq n (getint "\nSpecify number of double turns : ")) (initget 1 "Yes No") (setq c (getkword "\nAdditional middle turn [Yes/No] : ")) (if (= c "Yes") (progn (if (equal (cadr (trans (cdr (assoc 11 (entget ell))) 0 (cdr (assoc 210 (entget ell))))) 0.0 1e-8) (progn (setq d (/ (* 2 r2) (1+ (* 2 n)))) (setq p (list (+ (car ce) r1) (- (cadr ce) r2))) (setq pl (cons p pl)) (setq k -1) (repeat n (setq k (1+ k)) (setq p1 (polar (list (car ce) (+ (- (cadr ce) r2) (* (1+ k) d))) (* (1+ k) pi) (sqrt (- (expt r2 2) (expt (- r2 (* (1+ k) d)) 2))))) (setq p1 (polar (list (car ce) (+ (- (cadr ce) r2) (* k d))) (* (1+ k) pi) (abs (- (car (polar ce (angle ce p1) r1)) (car ce))))) (setq p2 (polar p1 (* 0.5 pi) d)) (setq pl (cons p1 pl) pl (cons p2 pl)) ) (setq p (polar (list (car ce) (cadr p2)) (if (= (rem n 2) 0) pi 0.0) (sqrt (- (expt r2 2) (expt (/ d 2) 2))))) (setq p (polar (list (car ce) (cadr p2)) (if (= (rem n 2) 0) pi 0.0) (abs (- (car (polar ce (angle ce p) r1)) (car ce))))) (setq pl (cons p pl)) (setq p (polar p (* 0.5 pi) d)) (setq pl (cons p pl)) (setq k -1) (repeat n (setq k (1+ k)) (setq p1 (polar (list (car ce) (+ (cadr ce) (* k d) (/ d 2))) (* (+ n k) pi) (sqrt (- (expt r2 2) (expt (* (+ k 0.5) d) 2))))) (setq p1 (polar (list (car ce) (+ (cadr ce) (* k d) (/ d 2))) (* (+ n k) pi) (abs (- (car (polar ce (angle ce p1) r1)) (car ce))))) (setq p2 (polar p1 (* 0.5 pi) d)) (setq pl (cons p1 pl) pl (cons p2 pl)) ) (setq p (list (+ (car ce) r1) (+ (cadr ce) r2))) (setq pl (cons p pl)) (setq pl (reverse pl)) ) (progn (setq d (/ (* 2 r1) (1+ (* 2 n)))) (setq p (list (+ (car ce) r2) (- (cadr ce) r1))) (setq pl (cons p pl)) (setq k -1) (repeat n (setq k (1+ k)) (setq p1 (polar (list (car ce) (+ (- (cadr ce) r1) (* (1+ k) d))) (* (1+ k) pi) (sqrt (- (expt r1 2) (expt (- r1 (* (1+ k) d)) 2))))) (setq p1 (polar (list (car ce) (+ (- (cadr ce) r1) (* k d))) (* (1+ k) pi) (abs (- (car (polar ce (angle ce p1) r2)) (car ce))))) (setq p2 (polar p1 (* 0.5 pi) d)) (setq pl (cons p1 pl) pl (cons p2 pl)) ) (setq p (polar (list (car ce) (cadr p2)) (if (= (rem n 2) 0) pi 0.0) (sqrt (- (expt r1 2) (expt (/ d 2) 2))))) (setq p (polar (list (car ce) (cadr p2)) (if (= (rem n 2) 0) pi 0.0) (abs (- (car (polar ce (angle ce p) r2)) (car ce))))) (setq pl (cons p pl)) (setq p (polar p (* 0.5 pi) d)) (setq pl (cons p pl)) (setq k -1) (repeat n (setq k (1+ k)) (setq p1 (polar (list (car ce) (+ (cadr ce) (* k d) (/ d 2))) (* (+ n k) pi) (sqrt (- (expt r1 2) (expt (* (+ k 0.5) d) 2))))) (setq p1 (polar (list (car ce) (+ (cadr ce) (* k d) (/ d 2))) (* (+ n k) pi) (abs (- (car (polar ce (angle ce p1) r2)) (car ce))))) (setq p2 (polar p1 (* 0.5 pi) d)) (setq pl (cons p1 pl) pl (cons p2 pl)) ) (setq p (list (+ (car ce) r2) (+ (cadr ce) r1))) (setq pl (cons p pl)) (setq pl (reverse pl)) ) ) (setq bl (cons 0.0 bl)) (setq k -1) (repeat (- (length pl) 2) (setq k (1+ k)) (if (= (rem k 2) 0) (setq bl (cons 0.0 bl)) (setq bl (if (zerop (apply '+ bl)) (cons -1.0 bl) (cons 1.0 bl))) ) ) (setq bl (cons 0.0 bl)) ) (progn (if (equal (cadr (trans (cdr (assoc 11 (entget ell))) 0 (cdr (assoc 210 (entget ell))))) 0.0 1e-8) (progn (setq d (/ r2 n)) (setq p (list (+ (car ce) r1) (- (cadr ce) r2))) (setq pl (cons p pl)) (setq k -1) (repeat n (setq k (1+ k)) (setq p1 (polar (list (car ce) (+ (- (cadr ce) r2) (* (1+ k) d))) (* (1+ k) pi) (sqrt (- (expt r2 2) (expt (- r2 (* (1+ k) d)) 2))))) (setq p1 (polar (list (car ce) (+ (- (cadr ce) r2) (* k d))) (* (1+ k) pi) (abs (- (car (polar ce (angle ce p1) r1)) (car ce))))) (setq p2 (polar p1 (* 0.5 pi) d)) (setq pl (cons p1 pl) pl (cons p2 pl)) ) (setq k -1) (repeat n (setq k (1+ k)) (setq p1 (polar (list (car ce) (+ (cadr ce) (* k d))) (* (+ n (1+ k)) pi) (sqrt (- (expt r2 2) (expt (* k d) 2))))) (setq p1 (polar (list (car ce) (+ (cadr ce) (* k d))) (* (+ n (1+ k)) pi) (abs (- (car (polar ce (angle ce p1) r1)) (car ce))))) (setq p2 (polar p1 (* 0.5 pi) d)) (setq pl (cons p1 pl) pl (cons p2 pl)) ) (setq p (list (- (car ce) r1) (+ (cadr ce) r2))) (setq pl (cons p pl)) (setq pl (reverse pl)) ) (progn (setq d (/ r1 n)) (setq p (list (+ (car ce) r2) (- (cadr ce) r1))) (setq pl (cons p pl)) (setq k -1) (repeat n (setq k (1+ k)) (setq p1 (polar (list (car ce) (+ (- (cadr ce) r1) (* (1+ k) d))) (* (1+ k) pi) (sqrt (- (expt r1 2) (expt (- r1 (* (1+ k) d)) 2))))) (setq p1 (polar (list (car ce) (+ (- (cadr ce) r1) (* k d))) (* (1+ k) pi) (abs (- (car (polar ce (angle ce p1) r2)) (car ce))))) (setq p2 (polar p1 (* 0.5 pi) d)) (setq pl (cons p1 pl) pl (cons p2 pl)) ) (setq k -1) (repeat n (setq k (1+ k)) (setq p1 (polar (list (car ce) (+ (cadr ce) (* k d))) (* (+ n (1+ k)) pi) (sqrt (- (expt r1 2) (expt (* k d) 2))))) (setq p1 (polar (list (car ce) (+ (cadr ce) (* k d))) (* (+ n (1+ k)) pi) (abs (- (car (polar ce (angle ce p1) r2)) (car ce))))) (setq p2 (polar p1 (* 0.5 pi) d)) (setq pl (cons p1 pl) pl (cons p2 pl)) ) (setq p (list (- (car ce) r2) (+ (cadr ce) r1))) (setq pl (cons p pl)) (setq pl (reverse pl)) ) ) (setq bl (cons 0.0 bl)) (setq k -1) (repeat (- (length pl) 2) (setq k (1+ k)) (if (= (rem k 2) 0) (setq bl (cons 0.0 bl)) (setq bl (if (zerop (apply '+ bl)) (cons 1.0 bl) (cons -1.0 bl))) ) ) (setq bl (cons 0.0 bl)) ) ) (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length pl)) (cons 70 (if (= (getvar 'plinegen) 1) 128 0)) (cons 38 (caddr (trans (cdr (assoc 10 (entget ell))) 0 (cdr (assoc 210 (entget ell)))))) ) (apply 'append (mapcar '(lambda ( a b ) (list (cons 10 (trans a 1 (cdr (assoc 210 (entget ell))))) (cons 42 b))) pl bl)) (list (assoc 210 (entget ell))) (list '(62 . 3)) ) ) ) ) (*error* nil) ) HTH, M.R. Edited May 2 by marko_ribar 1 Quote Link to comment Share on other sites More sharing options...
XDSoft Posted May 2 Share Posted May 2 [XDrX-PlugIn(159)] Create snake line over a circle (theswamp.org) https://www.theswamp.org/index.php?topic=59526.0 (defun c:xdtb_snakecircle (/ an box cir direc dist e1 e2 endln ents ents-pair ept1 ept2 firstln garc i ints items ln1 ln2 mode p1extend pl ptmid pts1 pts2 spt1 spt2 x y ) (defun _make-sharp-corners (direc) (setq items (nth direc ents-pair) e1 (car items) e2 (cadr items) ept2 (xdrx-curve-getendpoint e2) spt2 (xdrx-curve-getstartpoint e2) spt1 (xdrx-curve-getstartpoint e1) ept1 (xdrx-curve-getendpoint e1) ) (cond ((= (rem direc 2) 0) (if (< direc (/ #xd-var-global-divide-nums 2.0)) (progn (setq p1extend (xdrx-getpropertyvalue (list spt1 ept1) "getclosestpointto" ept2 t ) ptmid (xdrx-line-midp ept2 p1extend) ) (xdrx-curve-setsptept e1 ept1 p1extend) (if (= #xd-var-global-mode "1") (progn (setq ptmid (polar ptmid 0 (distance ptmid ept2))) (setq garc (xdge::constructor "kCircArc3d" p1extend ptmid ept2 ) ) (xdrx-entity-make garc) ) (progn (setq ptmid (polar ptmid 0 (* (distance ptmid ept2) 1.3))) (xdrx-line-make p1extend ptmid) (xdrx-line-make ptmid ept2) ) ) ) (progn (setq p1extend (xdrx-getpropertyvalue (list spt2 ept2) "getclosestpointto" ept1 t ) ptmid (xdrx-line-midp ept1 p1extend) ) (xdrx-curve-setsptept e2 ept2 p1extend) (if (= #xd-var-global-mode "1") (progn (setq ptmid (polar ptmid 0 (distance ptmid ept1))) (setq garc (xdge::constructor "kCircArc3d" p1extend ptmid ept1 ) ) (xdrx-entity-make garc) ) (progn (setq ptmid (polar ptmid 0 (* (distance ptmid ept1) 1.3))) (xdrx-line-make ept1 ptmid) (xdrx-line-make ptmid p1extend) ) ) ) ) ) (t (if (< direc (/ #xd-var-global-divide-nums 2.0)) (progn (setq p1extend (xdrx-getpropertyvalue (list spt1 ept1) "getclosestpointto" spt2 t ) ptmid (xdrx-line-midp spt2 p1extend) ) (xdrx-curve-setsptept e1 spt1 p1extend) (if (= #xd-var-global-mode "1") (progn (setq ptmid (polar ptmid pi (distance ptmid spt2))) (setq garc (xdge::constructor "kCircArc3d" p1extend ptmid spt2 ) ) (xdrx-entity-make garc) ) (progn (setq ptmid (polar ptmid pi (* (distance ptmid spt2) 1.3))) (xdrx-line-make p1extend ptmid) (xdrx-line-make ptmid spt2) ) ) ) (progn (setq p1extend (xdrx-getpropertyvalue (list spt2 ept2) "getclosestpointto" spt1 t ) ptmid (xdrx-line-midp spt1 p1extend) ) (xdrx-curve-setsptept e2 spt2 p1extend) (if (= #xd-var-global-mode "1") (progn (setq ptmid (polar ptmid pi (distance ptmid spt1))) (setq garc (xdge::constructor "kCircArc3d" p1extend ptmid spt1 ) ) (xdrx-entity-make garc) ) (progn (setq ptmid (polar ptmid pi (* (distance ptmid spt1) 1.3))) (xdrx-line-make spt1 ptmid) (xdrx-line-make ptmid p1extend) ) ) ) ) ) ) ) (setq #xd-var-global-mode "0") (xdrx-initget 0 "0 1") (if (setq mode (getkword (xdrx-string-formatex (xdrx-string-multilanguage "\n模式[标准(0)/圆弧(1)]<1>" "\nMode[standard(0)/arc(1)]<%s>") #xd-var-global-mode ) ) ) (setq #xd-var-global-mode mode) ) (xdrx-initget) (xd::doc:getint (xdrx-string-multilanguage "\n等分数" "\nDivide Nums") "#xd-var-global-divide-nums" 20 ) (if (setq cir (car (xdrx-entsel (xdrx-string-multilanguage "\n拾取圆<退出>:" "\nPick Circle<Exit>:") '((0 . "circle")) ) ) ) (progn (xdrx-begin) (xdrx-setmark) (setq box (xdrx-entity-box cir) ln1 (list (nth 3 box) (nth 0 box)) pts1 (xdrx-getpropertyvalue ln1 "getsamplepoints" #xd-var-global-divide-nums ) ln2 (list (nth 2 box) (nth 1 box)) pts2 (xdrx-getpropertyvalue ln2 "getsamplepoints" #xd-var-global-divide-nums ) an (angle (car pts2) (car pts1)) firstln (list (polar (car pts1) an (/ (distance (car pts1) (car pts2) ) 7.0 ) ) (car pts2) ) an (angle (car pts1) (car pts2)) dist (/ (distance (last pts1) (last pts2)) 7.0) endln (if (= (rem #xd-var-global-divide-nums 2) 1) (list (polar (last pts1) (+ an pi) dist) (last pts2)) (list (last pts1) (polar (last pts2) an dist)) ) pts1 (cdr (xd::list:removetail pts1)) pts2 (cdr (xd::list:removetail pts2)) ents nil ) (xdrx-line-make firstln) (setq ents (cons (entlast) ents)) (mapcar '(lambda (x y) (setq ints (xdrx-entity-intersectwith (list x y) cir) ints (xdrx-points-sortoncurve (list x y) ints) ) (apply 'xdrx-line-make ints ) (setq ents (cons (entlast) ents)) ) pts1 pts2 ) (xdrx-line-make endln) (setq ents (cons (entlast) ents) ents (reverse ents) ents-pair (xd::list:snakepair ents) ) (setq i -1) (repeat (length ents-pair) (setq i (1+ i)) (_make-sharp-corners i) ) (xdrx-curve-join (xdrx-getss)) (setq pl (entlast)) (xdrx-entity-setcolor pl 1) (xdrx-end) ) ) (princ) ) ===================== The above code uses XDrx API, download link: https://github.com/xdcad/XDrx-API-zip https://sourceforge.net/projects/xdrx-api-zip/ Dual version link: https://github.com/xdcad 1 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.