Code Red > XDRX-API
[XDrX-PlugIn(159)] Create snake line over a circle
(1/1)
xdcad:
https://www.cadtutor.net/forum/topic/61650-create-snake-line-over-a-circle/
--- Code: ---(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)
)
--- End code ---
Navigation
[0] Message Index
Go to full version