0 Members and 1 Guest are viewing this topic.
(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))