用插密多段线替换圆弧
本帖最后由 重慶崽兒 于 2015-9-26 16:54 编辑前些天看见同事用PL线在圆弧上一点点的画，于心不忍，于是便有了：
(defun c:tt( / aname bj hc_1 huchang i jsd ksd l name ss bc huchang_1 yxj ii lst pt)
(setq *error*_bak *error*)
(setq *error* *error*_non)
(setq osmode_bak (getvar "osmode"))
(setvar "osmode" 0)
(setq Gridmode_bak (getvar "Gridmode"))
(setvar "Gridmode" 0)
(setq ss (ssget '((0 . "ARC"))))
(setq l (getreal "\n请输入点间距:"))
(setq i 0)
(if (> l 0)
(repeat (sslength ss)
(setq name (ssname ss i))
(setq bj (cdr (assoc 40 (entget name))))
(setq aname (vlax-ename->vla-object name))
(setq ksd (vlax-curve-getStartPoint aname))
(setq jsd (vlax-curve-getEndPoint aname))
(setq huchang (vlax-curve-getDistAtParam aname (vlax-curve-getendparam aname)))
(if (>= (/ l 2.0) bj)
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 2) (cons 10 ksd) (cons 10 jsd)))
(progn
(setq hc_1 (shc l bj))
(huaxian hc_1 huchang aname ksd jsd)
)
)
(setq i (1+ i))
)
(progn
(alert "输入有误！")
(exit)
)
)
(setvar "osmode" osmode_bak)
(setvar "Gridmode" Gridmode_bak)
(setq *error* *error*_bak)
(princ)
)
(defun shc (l bj / )
(setq bc (sqrt (- (expt bj 2) (expt (/ l 2.0) 2))))
(setq yxj (* (/ (* (atan (/ l 2.0) bc) 180) pi) 2.0))
(setq huchang_1 (/ (* yxj pi bj) 180.0))
)
(defun huaxian (hc_1 huchang en ksd jsd / )
(if (< hc_1 huchang)
(progn
(setq ii 0 lst nil)
(while (< ii huchang)
(setq pt (vlax-curve-getPointAtDist en ii))
(setq lst (append lst (list pt)))
(setq ii (+ ii hc_1))
)
(setq lst (append lst (list jsd)))
(entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst))) (mapcar '(lambda (x) (cons 10 x)) lst)))
)
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 2) (cons 10 ksd) (cons 10 jsd)))
)
)
(defun *error*_non (msg)
(command)
(setvar "osmode" osmode_bak)
(setvar "Gridmode" Gridmode_bak)
(setq *error* *error*_bak)
(princ)
)
写的不好，各位莫笑
重慶崽兒 发表于 2015-9-29 21:50
额，你是定数等分吧，我也写过，但我这边用不到，要是和多段线面积差不多的话，估计点很密吧，好思路，要 ...
lisp不懂哦，现在都是用C++实现的 edata 发表于 2015-9-28 22:16
没细看你做的是定距弦长，修改如下。
能否改成带有记忆功能的呀，不用每次都输入间距 土木燃 发表于 2018-10-18 16:00
我也觉得，要再有一个多段线转圆弧就完美了。需要用到
同求 多段线转圆弧 实用最好。 感谢 重庆崽儿 分享程序!!! 定距等分，没有用command命令的情况下，不建议更改捕捉值，格栅模式这里没什么意义吧程序有3处生成多段线，其实可以合在一处即可，没必要分开，尝试生成定距点表，最后生成多段线即可。 edata 发表于 2015-9-27 08:47 static/image/common/back.gif
定距等分，没有用command命令的情况下，不建议更改捕捉值，格栅模式这里没什么意义吧程序有3处生成多段线， ...
首先谢谢E大
我想说下我为什么要这样写：
更改捕捉模式的话的是为了保险起见，怕出错
栅格模式我觉得是必要的，有时候图纸很大，平移缩放的时候会提示：“栅格太密，无法显示”整个人感觉都不好了。
至于三处生成多段线，其实每个圆弧都只会用到一个，我通过判断来决定使用哪一个的
这个程序确实还要很多可以优化的地方
不知道E大有没有什么更好的思路，谢谢
本帖最后由 edata 于 2015-9-27 20:29 编辑
;圆弧转PL线
;code by edata @mjtd.com 2015-9-27 19:37:27
(defun c:tt(/ ss en ds lst x)
(if(and (setq ss(ssget '((0 . "arc"))))
(setq ds(getreal "\n输入等分间距:")))
(while(setq en(ssname ss 0))
(setq lst(sk_div_pts en ds))
(and lst
(entmake (append (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length lst))
)
(mapcar '(lambda (x) (cons 10 x)) lst)
)
)
)
(setq ss(ssdel en ss))
)
)
(princ)
)
;;arc定距等分函数
(defun sk_div_pts(en ds / obj arc_len lst i reptime)
(if en
(progn
(setq obj(vlax-ename->vla-object en)
arc_len(vla-get-arclength obj)
)
(cond
((>= ds arc_len)
(setq lst(list(vlax-curve-getStartPoint obj)(vlax-curve-getEndPoint obj)))
)
((< ds arc_len)
(setq reptime(1+ (fix (/ arc_len ds))))
(setq i -1)
(repeat reptime
(setq lst(cons (vlax-curve-getPointAtDist obj (* ds (setq i(1+ i)))) lst))
)
(if (not(equal (vlax-curve-getEndPoint obj) (car lst) 1e-8))
(setq lst(cons (vlax-curve-getEndPoint obj) lst))
)
)
)
)
)
) edata 发表于 2015-9-27 19:37 static/image/common/back.gif
谢谢E大的代码，刚才看了下，程序效率很高
但是我觉得这样的算法不是很好，因为这样创建的多段线的点间距并不是用户输入的点间距，而是那一段子弧的长度，比如：
这里我输入的是20，得到的点间距却是19.9489，而子弧的长度是20，我觉得应该将用户输入的长度当成是那一段子弧的弦长，然后算子圆弧的圆心角，半径不变，这样来得到子圆弧的弧长，然后再创建多段线！
小子随性妄语，E大看看笑笑就是 没细看你做的是定距弦长，修改如下。
;圆弧转PL线弦长定距版
;code by edata @mjtd.com 2015-9-28 22:14:47
(defun c:tt(/ ss en ds lst x)
(if(and (setq ss(ssget '((0 . "arc"))))
(setq ds(getreal "\n输入等分弦长间距:")))
(while(setq en(ssname ss 0))
(setq lst(sk_div_pts en ds))
(and lst
(entmake (append (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length lst))
)
(mapcar '(lambda (x) (cons 10 x)) lst)
)
)
)
(setq ss(ssdel en ss))
)
)
(princ)
)
;;arc定距弦长等分函数
(defun sk_div_pts(en ds / obj arc_len lst i reptime cen pt rad xian_len)
(if en
(progn
(setq obj(vlax-ename->vla-object en)
arc_len(vla-get-arclength obj)
xian_len(distance (vlax-curve-getStartPoint obj)(vlax-curve-getEndPoint obj))
)
(cond
((or (>= ds xian_len) (>= ds arc_len))
(setq lst(list(vlax-curve-getStartPoint obj)(vlax-curve-getEndPoint obj)))
)
((< ds arc_len)
(setq reptime (fix (/ arc_len ds)))
(setq i -1
pt (vlax-curve-getStartPoint obj)
rad(vla-get-radius obj)
cen(cdr(assoc 10 (entget en)))
lst(list pt))
(repeat reptime
(setq pt(polar cen (+ (angle cen pt) (sk_atan (* ds 0.5) rad)) rad))
(setq lst(cons pt lst))
)
(if (not(equal (vlax-curve-getEndPoint obj) (car lst) 1e-8))
(setq lst(cons (vlax-curve-getEndPoint obj) lst))
)
)
)
)
)
)
;;已知弦长半径求圆心角
(defun sk_atan(a c / b)
(if(and a c)
(progn
(setq b(sqrt(abs(-(* c c)(* a a)))))
(* (atan (/ (* a 1.0) b)) 2.0)
)
)
) 牛逼的高手啊， 程序只能从弧的右侧到左侧吗