沿多线段画圆

pxr201419 · 发表于 2019-5-19 13:28:44

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun c:BY( / kd jl en nen ii st1 nst1 sy ss ks x y jd ss po0 po1 po2 gs) ;沿线段画圆和标数字
(setvar "OSMODE" 0)
(setq kd (getreal "输入开始空出的距离："))
(if (= kd nil)(setq kd 0.0))
(setq jl (getreal "输入间距："))
(setq en (entget (car (entsel "\n请选择一条多线段:"))))
(setq nen (length en) ii 0 st1 nil)
(while (< ii nen)
(setq lii (car (nth ii en)))
(if (= lii 10)(setq st1 (cons (cdr (nth ii en)) st1)))
(setq ii (1+ ii))
)
(setq st1 (reverse st1) nst1 (length st1) ii 0 sy 0.0 ks nil)
(while (< ii (1- nst1))
(setq po1 (nth ii st1) po2 (nth (1+ ii) st1))
(setq x (car po1) y (cadr po1))
(setq jd (angle po1 po2))
      (setq ss (+ (distance po1 po2) sy))
(if (= ks nil)
(progn
(if (>= ss kd)
(progn (setq po0 (list (+ x (* (cos jd) (- kd sy))) (+ y (* (sin jd) (- kd sy)))))
(command "circle" po0 500.0)(command "text" "j" "m" po0 500 0 "1")(setq gs 2)
(setq ks t)
(setq x (car po0) y (cadr po0))
(setq ss (- ss kd)) )
(setq sy ss)
)))
(if (= ks t)
(progn
(if (<= jl ss)
(progn (while (<= jl ss)
     (setq po1 (list (+ x (* (cos jd) (- jl sy))) (+ y (* (sin jd) (- jl sy)))))
(command "circle" po1 500.0)(command "text" "j" "m" po1 500 0 gs)(setq gs (1+ gs))
(setq x (car po1) y (cadr po1))
(setq ss (- ss jl) sy 0.0)
)
(setq sy ss)
)
     (setq sy ss)
)))
(setq ii (1+ ii))
)
(princ)
)

huangpc27 · 发表于 2019-5-19 20:59:07

谢谢分享啊

ynhh · 发表于 2019-5-20 08:26:09

谢谢分享
建议用黑屏不伤眼
谢谢

sicky111 · 发表于 2019-5-20 09:18:42

谢谢分享。

yoyoho · 发表于 2019-5-20 12:09:20

谢谢分享程序!!!!!

kqqt6236 · 发表于 2019-5-21 00:56:24

沿多段线路径等分复制。

账号		自动登录	找回密码
密码			立即注册

[原创] 沿多线段画圆

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分