在圆圈上创建蛇线
你好希望有人能帮助我的要求。
我想用4个参数在圆上画一条多段线。
基本上，用户应该指定圆心（1）、圆半径（2）、线之间的偏移距离（3）和到折返点的距离（4）。
我能够将我的大部分想法转换成Lisp程序的语言，但有了这一点，我需要一些指导。我知道这是纯数学，但我不知道如何用交点、直线、偏移的代码来表达它。。。 其可行的方法是：首先取顶部象限pt绘制一条线，水平偏移向下直径/编号，然后使用intersectwith计算新的pt偏移向下走反向相交，等等。第二行，直线相切任何角度都一样。
考虑得再多一点，实际上需要像两个defuns一样按顺序左右运行，因为它们是两行分开的。对于左开始右结束，倍数始终为（直径/数量）*2+1。
你们有中心，所以通过简单的极坐标知道象限，只需要跟踪点交换p1=p8 p2=p5等等。当我这样做的时候，我得到一张纸，在上面画出带有pt数字的对象，这样我可以在创建时跟踪添加，然后重复就会变得明显。
; 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))
这是我的版本与凸-弧。。。
(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 : "))
(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。
页:
[1]