设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 用插密多段线替换圆弧
123下一页
返回列表 发新帖
查看: 5872|回复: 28

[源码] 用插密多段线替换圆弧

  [复制链接]
重慶崽兒
发表于 2015-9-26 16:52:27 | 显示全部楼层 |阅读模式
本帖最后由 重慶崽兒 于 2015-9-26 16:54 编辑

前些天看见同事用PL线在圆弧上一点点的画，于心不忍，于是便有了：
  1. (defun c:tt( / aname bj hc_1 huchang i jsd ksd l name ss bc huchang_1 yxj ii lst pt)
  2.   (setq *error*_bak *error*)
  3.   (setq *error* *error*_non)
  4.   (setq osmode_bak (getvar "osmode"))
  5.   (setvar "osmode" 0)
  6.   (setq Gridmode_bak (getvar "Gridmode"))
  7.   (setvar "Gridmode" 0)
  8.   (setq ss (ssget '((0 . "ARC"))))
  9.   (setq l (getreal "\n请输入点间距:"))
  10.   (setq i 0)
  11.   (if (> l 0)
  12.     (repeat (sslength ss)
  13.       (setq name (ssname ss i))
  14.       (setq bj (cdr (assoc 40 (entget name))))
  15.       (setq aname (vlax-ename->vla-object name))
  16.       (setq ksd (vlax-curve-getStartPoint aname))
  17.       (setq jsd (vlax-curve-getEndPoint aname))
  18.       (setq huchang (vlax-curve-getDistAtParam aname (vlax-curve-getendparam aname)))
  19.       (if (>= (/ l 2.0) bj)
  20.         (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 2) (cons 10 ksd) (cons 10 jsd)))
  21.         (progn
  22.           (setq hc_1 (shc l bj))
  23.           (huaxian hc_1 huchang aname ksd jsd)
  24.         )
  25.       )
  26.       (setq i (1+ i))
  27.     )
  28.     (progn
  29.       (alert "输入有误！")
  30.       (exit)
  31.     )
  32.   )
  33.   (setvar "osmode" osmode_bak)
  34.   (setvar "Gridmode" Gridmode_bak)
  35.   (setq *error* *error*_bak)
  36.   (princ)
  37. )



  41. (defun shc (l bj / )
  42.   (setq bc (sqrt (- (expt bj 2) (expt (/ l 2.0) 2))))
  43.   (setq yxj (* (/ (* (atan (/ l 2.0) bc) 180) pi) 2.0))
  44.   (setq huchang_1 (/ (* yxj pi bj) 180.0))
  45. )


  48. (defun huaxian (hc_1 huchang en ksd jsd / )
  49.   (if (< hc_1 huchang)
  50.     (progn
  51.       (setq ii 0 lst nil)
  52.       (while (< ii huchang)
  53.         (setq pt (vlax-curve-getPointAtDist en ii))
  54.         (setq lst (append lst (list pt)))
  55.         (setq ii (+ ii hc_1))
  56.       )
  57.       (setq lst (append lst (list jsd)))
  58.       (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst))) (mapcar '(lambda (x) (cons 10 x)) lst)))
  59.     )
  60.    
  61.     (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 2) (cons 10 ksd) (cons 10 jsd)))
  62.   )
  63. )



  67. (defun *error*_non (msg)
  68.   (command)
  69.   (setvar "osmode" osmode_bak)
  70.   (setvar "Gridmode" Gridmode_bak)
  71.   (setq *error* *error*_bak)
  72.   (princ)
  73. )



写的不好，各位莫笑

本帖子中包含更多资源

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

x
回复

使用道具 举报

lysygyy
发表于 2017-12-18 11:35:24 | 显示全部楼层
重慶崽兒 发表于 2015-9-29 21:50
额，你是定数等分吧，我也写过，但我这边用不到，要是和多段线面积差不多的话，估计点很密吧，好思路，要 ...

lisp不懂哦，现在都是用C++实现的
回复 支持 反对

使用道具 举报

yangchao2005090
发表于 2018-1-3 11:16:45 | 显示全部楼层
edata 发表于 2015-9-28 22:16
没细看你做的是定距弦长，修改如下。

能否改成带有记忆功能的呀，不用每次都输入间距
回复 支持 反对

使用道具 举报

依然小小鸟
发表于 2023-6-1 12:46:07 | 显示全部楼层
土木燃 发表于 2018-10-18 16:00
我也觉得，要再有一个多段线转圆弧就完美了。需要用到

同求 多段线转圆弧
回复 支持 反对

使用道具 举报

ttmc
发表于 2015-9-26 17:16:35 | 显示全部楼层
实用最好。
回复 支持 反对

使用道具 举报

yoyoho
发表于 2015-9-26 22:22:37 | 显示全部楼层
感谢 重庆崽儿 分享程序!!!
回复 支持 反对

使用道具 举报

edata
发表于 2015-9-27 08:47:49 来自手机 | 显示全部楼层
定距等分，没有用command命令的情况下，不建议更改捕捉值，格栅模式这里没什么意义吧程序有3处生成多段线，其实可以合在一处即可，没必要分开，尝试生成定距点表，最后生成多段线即可。
回复 支持 反对

使用道具 举报

重慶崽兒
 楼主| 发表于 2015-9-27 17:00:26 | 显示全部楼层
edata 发表于 2015-9-27 08:47
定距等分，没有用command命令的情况下，不建议更改捕捉值，格栅模式这里没什么意义吧程序有3处生成多段线， ...

首先谢谢E大
我想说下我为什么要这样写：
更改捕捉模式的话的是为了保险起见，怕出错
栅格模式我觉得是必要的，有时候图纸很大，平移缩放的时候会提示：“栅格太密，无法显示”  整个人感觉都不好了。
至于三处生成多段线，其实每个圆弧都只会用到一个，我通过判断来决定使用哪一个的
这个程序确实还要很多可以优化的地方
不知道E大有没有什么更好的思路，谢谢
回复 支持 反对

使用道具 举报

edata
发表于 2015-9-27 19:37:58 | 显示全部楼层
本帖最后由 edata 于 2015-9-27 20:29 编辑

  1. ;圆弧转PL线
  2. ;code by edata @mjtd.com 2015-9-27 19:37:27
  3. (defun c:tt(/ ss en ds lst x)
  4.   (if(and (setq ss(ssget '((0 . "arc"))))
  5.           (setq ds(getreal "\n输入等分间距:")))
  6.     (while(setq en(ssname ss 0))
  7.       (setq lst(sk_div_pts en ds))
  8.       (and lst
  9.            (entmake (append (list '(0 . "LWPOLYLINE")
  10.                                   '(100 . "AcDbEntity")
  11.                                   '(100 . "AcDbPolyline")
  12.                                   (cons 90 (length lst))
  13.                             )
  14.                             (mapcar '(lambda (x) (cons 10 x)) lst)
  15.                     )
  16.            )
  17.       )
  18.       (setq ss(ssdel en ss))
  19.       )
  20.     )
  21.   (princ)
  22.   )
  23. ;;arc定距等分函数
  24. (defun sk_div_pts(en ds / obj arc_len lst i reptime)
  25.   (if en
  26.     (progn
  27.       (setq obj(vlax-ename->vla-object en)
  28.             arc_len(vla-get-arclength obj)
  29.             )
  30.       (cond
  31.         ((>= ds arc_len)
  32.          (setq lst(list(vlax-curve-getStartPoint obj)(vlax-curve-getEndPoint obj)))
  33.          )
  34.         ((< ds arc_len)
  35.          (setq reptime(1+ (fix (/ arc_len ds))))
  36.          (setq i -1)
  37.          (repeat reptime
  38.            (setq lst(cons (vlax-curve-getPointAtDist obj (* ds (setq i(1+ i)))) lst))
  39.            )
  40.          (if (not(equal (vlax-curve-getEndPoint obj) (car lst) 1e-8))
  41.            (setq lst(cons (vlax-curve-getEndPoint obj) lst))
  42.            )
  43.          )
  44.         )
  45.       )
  46.     )
  47.   )
回复 支持 反对

使用道具 举报

重慶崽兒
 楼主| 发表于 2015-9-27 22:28:21 | 显示全部楼层
edata 发表于 2015-9-27 19:37

谢谢E大的代码，刚才看了下，程序效率很高
但是我觉得这样的算法不是很好，因为这样创建的多段线的点间距并不是用户输入的点间距，而是那一段子弧的长度，比如：

这里我输入的是20，得到的点间距却是19.9489，而子弧的长度是20，我觉得应该将用户输入的长度当成是那一段子弧的弦长，然后算子圆弧的圆心角，半径不变，这样来得到子圆弧的弧长，然后再创建多段线！
小子随性妄语，E大看看笑笑就是

本帖子中包含更多资源

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

x
回复 支持 反对

使用道具 举报

edata
发表于 2015-9-28 22:16:15 | 显示全部楼层
没细看你做的是定距弦长，修改如下。
  1. ;圆弧转PL线弦长定距版
  2. ;code by edata @mjtd.com 2015-9-28 22:14:47
  3. (defun c:tt(/ ss en ds lst x)
  4.   (if(and (setq ss(ssget '((0 . "arc"))))
  5.           (setq ds(getreal "\n输入等分弦长间距:")))
  6.     (while(setq en(ssname ss 0))
  7.       (setq lst(sk_div_pts en ds))
  8.       (and lst
  9.            (entmake (append (list '(0 . "LWPOLYLINE")
  10.                                   '(100 . "AcDbEntity")
  11.                                   '(100 . "AcDbPolyline")
  12.                                   (cons 90 (length lst))
  13.                             )
  14.                             (mapcar '(lambda (x) (cons 10 x)) lst)
  15.                     )
  16.            )
  17.       )
  18.       (setq ss(ssdel en ss))
  19.       )
  20.     )
  21.   (princ)
  22.   )
  23. ;;arc定距弦长等分函数
  24. (defun sk_div_pts(en ds / obj arc_len lst i reptime cen pt rad xian_len)
  25.   (if en
  26.     (progn
  27.       (setq obj(vlax-ename->vla-object en)
  28.             arc_len(vla-get-arclength obj)
  29.             xian_len(distance (vlax-curve-getStartPoint obj)(vlax-curve-getEndPoint obj))            
  30.             )
  31.       (cond
  32.         ((or (>= ds xian_len) (>= ds arc_len))
  33.          (setq lst(list(vlax-curve-getStartPoint obj)(vlax-curve-getEndPoint obj)))
  34.          )
  35.         ((< ds arc_len)
  36.          (setq reptime (fix (/ arc_len ds)))
  37.          (setq i -1
  38.                pt (vlax-curve-getStartPoint obj)
  39.                rad(vla-get-radius obj)
  40.                cen(cdr(assoc 10 (entget en)))
  41.                lst(list pt))
  42.          (repeat reptime
  43.            (setq pt(polar cen (+ (angle cen pt) (sk_atan (* ds 0.5) rad)) rad))
  44.            (setq lst(cons pt lst))
  45.            )
  46.          (if (not(equal (vlax-curve-getEndPoint obj) (car lst) 1e-8))
  47.            (setq lst(cons (vlax-curve-getEndPoint obj) lst))
  48.            )
  49.          )
  50.         )
  51.       )
  52.     )
  53.   )
  54. ;;已知弦长半径求圆心角
  55. (defun sk_atan(a c / b)
  56.   (if(and a c)
  57.     (progn
  58.       (setq b(sqrt(abs(-(* c c)(* a a)))))
  59.       (* (atan (/ (* a 1.0) b)) 2.0)
  60.       )
  61.     )
  62.   )
回复 支持 反对

使用道具 举报

culiang10086
发表于 2015-9-29 13:06:05 | 显示全部楼层
牛逼的高手啊，
回复 支持 反对

使用道具 举报

culiang10086
发表于 2015-9-29 13:30:54 | 显示全部楼层
程序只能从弧的右侧到左侧吗
回复 支持 反对

使用道具 举报

123下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-11-16 21:54 , Processed in 0.191983 second(s), 31 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表