分享源码，同时求助！

lucas_3333

看名字，大家就应该知道是什么了吧！这里就不解释了。看演示图，原作者Alanjt



我的问题是 沿曲线布置圆弧 ，这里指的曲线包括(line, pline, circle, arc, ellipse)
不是先画一个弧，然后选择沿曲线布置，
而是运行命令，输入参数（宽度W, 间隔）后，拾取曲线后，指定起点，终点就自动布置了，

可以指定起点，终点


可以设定尺寸（宽度与间隔）

q3_2006

(defun mkarc (p w f / p1 p2)
(cond
  ((= f 3) (setq p1 (mapcar '- p (list (* -0.25 w) (* 0.5 (abs w)) ))
  p2 (mapcar '- p (list 0 (abs w) ))
)
(vl-cmdf "arc" p p1 p2)
)
  ((= f 2) (setq p1 (mapcar '+ p (list (* 0.25 w) (* -0.5 (abs w)) ))
  p2 (mapcar '+ p (list (* 0.25 w) (* 0.5 (abs w)) ))
)
(vl-cmdf "arc" p1 p p2)
)
  ((= f 1) (setq p1 (mapcar '+ p (list (* 0.25 w) (* 0.5 (abs w)) ))
  p2 (mapcar '+ p (list 0 (abs w) ))
)
(vl-cmdf "arc" p p1 p2)
)
)
(entlast)
)
(defun mat:rotation ( cen ang / c s x y)
  (setq c (cos ang) s (sin ang))
  (setq x (car cen) y (cadr cen))
  (list
    (list c (- s) 0. (- x (- (* c x) (* s y))))
    (list s    c  0. (- y (+ (* s x) (* c y))))
    '(0. 0. 1. 0.)
    '(0. 0. 0. 1.)
  )
)
(defun HH:PtFirstAngle (obj pt)
  (setq param (vlax-curve-getParamAtPoint obj pt))
  (angle pt (mapcar '+ pt (vlax-curve-getFirstDeriv obj param)))
)
(defun c:tt ( / aa a an d d1 d2 e f i l odlst p1 p2 pr q w x y)
(setq odlst (mapcar 'getvar '("cmdecho" "osmode" "peditaccept")))
(mapcar 'setvar '("cmdecho" "osmode") '(0 544))
(setq w (getreal "\n输入圆弧宽度:") ;负值反向
  d (getreal "\n输入圆弧间距:")
  a (car (entsel "\n选择曲线:"))
  p1 (getpoint "\n起点:")
  p2 (getpoint "\n终点:")
  l (list p1 p2)
  l (vl-sort l '(lambda (x y) (< (vlax-curve-getDistAtPoint a x) (vlax-curve-getDistAtPoint a y)) ) )
  p1 (car l)
  p2 (cadr l)
  d1 (vlax-curve-getDistAtPoint a p1)
  d2 (vlax-curve-getDistAtPoint a p2)
  i -1
  l nil
)
(while (< (setq pr (+ (* (setq i (1+ i)) d) d1)) d2)
  (setq l (cons (vlax-curve-getPointAtDist a pr) l))
)
(setq l (reverse l))
(setvar "osmode" 0)
(princ "\n[1上,2中,3下]")
(setq aa (grread))
(cond
  ((= (cadr aa) 49) (setq f 1) )
  ((= (cadr aa) 50) (setq f 2) )
  ((= (cadr aa) 51) (setq f 3) )
)
(mapcar '(lambda(x)
(setq an (HH:PtFirstAngle a x) q (mat:rotation x an) e (mkarc x w f))
(vla-transformby (vlax-ename->vla-object e) (vlax-tmatrix q))
) l)
(mapcar 'setvar '("cmdecho" "osmode") odlst)
)

love1030312

顶起  感谢分享

yoyoho

感谢 lucas_3333  分享程序!

Atsai

圓弧凹向start or end?

lucas_3333

Atsai 发表于 2014-9-2 17:50
圓弧凹向start or end?

可以选择方向最好，凹向或凸向可以选择

lucas_3333

q3_2006 发表于 2014-9-2 19:19

谢谢帮助！
只是怎么只支持Line ？
pline, circle, arc, ellipse都只能在起点与终点画一个圆弧呢？

q3_2006

lucas_3333 发表于 2014-9-2 19:27
谢谢帮助！
只是怎么只支持Line ？
pline, circle, arc, ellipse都只能在起点与终点画一个圆弧呢 ...

我用SPLINE...测试的...没看要求...

lucas_3333

q3_2006 发表于 2014-9-2 19:56
我用SPLINE...测试的...没看要求...

哈哈，SPLINE都搞定了，那其它的应改不是难事

q3_2006

lucas_3333 发表于 2014-9-2 19:59
哈哈，SPLINE都搞定了，那其它的应改不是难事

已经改了....