Topic: [XDrX-PlugIn(159)] Create snake line over a circle

[xdcad]

https://www.cadtutor.net/forum/topic/61650-create-snake-line-over-a-circle/

Code: [Select]

(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)
)