明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
楼主: yjr111

[源码] 转换多段线

  [复制链接]
发表于 2013-4-4 22:29 | 显示全部楼层
敢问楼主转换为pl线的目的是?

点评

软件转换用  发表于 2013-4-4 22:35
回复

使用道具 举报

发表于 2013-4-5 08:48 | 显示全部楼层
仅支持闭合多段线
  1. (defun PLConvert (PLEntName / PtsLst0 PtsLst1 MinLeng LinLeng PtsLst2 Pnt0 Pnt1 Pnt2 Pnt3 Pnt4 Pnt5)
  2.   (setq        PtsLst0        (mapcar        'cdr
  3.                         (vl-remove-if
  4.                           '(lambda (x) (/= 10 (car x)))
  5.                           (entget PLEntName)
  6.                         )
  7.                 )
  8.         PtsLst1        (append (cdr PtsLst0) (list (car PtsLst0)))
  9.         MinLeng        (apply '+ (mapcar 'distance PtsLst1 PtsLst0))
  10.         PtsLst1        (mapcar 'list PtsLst0 PtsLst1)
  11.   )
  12.   (foreach x PtsLst1
  13.     (if        (< (setq LinLeng (apply 'distance x)) MinLeng)
  14.       (setq MinLeng LinLeng
  15.             PtsLst2 x
  16.       )
  17.     )
  18.   )
  19.   (setq        Pnt0        (car PtsLst2)
  20.         Pnt1        (cadr PtsLst2)
  21.         Pnt2        (mapcar '* (mapcar '+ Pnt0 Pnt1) '(0.5 0.5 0.5))
  22.         PtsLst0        (append        (member Pnt0 PtsLst0)
  23.                         (reverse (cdr (member Pnt0 (reverse PtsLst0))))
  24.                 )
  25.         PtsLst0        (append (cddr PtsLst0) PtsLst2)
  26.         Pnt3        Pnt1
  27.         PtsLst1        (list Pnt2)
  28.   )
  29.   (while (not (equal Pnt3 Pnt0))
  30.     (setq Pnt4 (car PtsLst0)
  31.           Pnt5 (cadr PtsLst0)
  32.           Pnt2 (polar Pnt2 (angle Pnt3 Pnt4) (distance Pnt3 Pnt4))
  33.     )
  34.     (if (vlax-curve-getParamAtPoint PLEntName Pnt2)
  35.       (setq Pnt2    (polar Pnt2 (angle Pnt4 Pnt3) (* MinLeng 0.5))
  36.             PtsLst1 (cons Pnt2 PtsLst1)
  37.             Pnt2    (polar Pnt2 (angle Pnt5 Pnt4) (* MinLeng 0.5))
  38.             PtsLst1 (cons Pnt2 PtsLst1)
  39.       )
  40.       (setq Pnt2    (polar Pnt2 (angle Pnt3 Pnt4) (* MinLeng 0.5))
  41.             PtsLst1 (cons Pnt2 PtsLst1)
  42.             Pnt2    (polar Pnt2 (angle Pnt4 Pnt5) (* MinLeng 0.5))
  43.             PtsLst1 (cons Pnt2 PtsLst1)
  44.       )
  45.     )
  46.     (setq Pnt3          Pnt4
  47.           PtsLst0 (cdr PtsLst0)
  48.     )
  49.   )
  50.   (setq PtsLst1 (reverse PtsLst1)
  51.         PtsLst1 (mapcar '(lambda (x) (cons 10 x)) PtsLst1)
  52.         PtsLst2 (length PtsLst1)
  53.         PtsLst1 (mapcar '(lambda (x) (list (cons 40 MinLeng) (cons 41 MinLeng) x)) PtsLst1)
  54.         PtsLst1 (cddr (apply 'append PtsLst1))
  55.         )
  56.   (entmake
  57.     (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (100 . "AcDbPolyline") (8 . "0") (62 . 6) (70 . 0))
  58.             (list (cons 90  PtsLst2))
  59.             PtsLst1
  60.     )
  61.   )
  62. )

评分

参与人数 1明经币 +1 金钱 +10 收起 理由
yjr111 + 1 + 10 很给力!

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2013-4-5 10:03 | 显示全部楼层
nzl1116 发表于 2013-4-5 08:48
仅支持闭合多段线

很棒,不过有些情况会出错,比如下面简单图形

本帖子中包含更多资源

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

x
回复

使用道具 举报

发表于 2013-4-5 10:10 | 显示全部楼层
yjr111 发表于 2013-4-5 10:03
很棒,不过有些情况会出错,比如下面简单图形

这简单,稍微修复下就可以了
回复

使用道具 举报

发表于 2013-4-5 10:37 | 显示全部楼层
  1. (defun PLConvert (PLEntName / PtsLst0 PtsLst1 MinLeng LinLeng PtsLst2 Pnt0 Pnt1 Pnt2 Pnt3 Pnt4 Pnt5)
  2.   ;;获取闭合多段线所有顶点的坐标
  3.   (setq        PtsLst0        (mapcar        'cdr
  4.                         (vl-remove-if
  5.                           '(lambda (x) (/= 10 (car x)))
  6.                           (entget PLEntName)
  7.                         )
  8.                 )
  9.         ;;将起点后置
  10.         PtsLst1        (append (cdr PtsLst0) (list (car PtsLst0)))
  11.         ;;初始化最小长度为闭合多段线的总长
  12.         MinLeng        (apply '+ (mapcar 'distance PtsLst1 PtsLst0))
  13.         ;;获取多段线每一段的点对表
  14.         PtsLst1        (mapcar 'list PtsLst0 PtsLst1)
  15.   )
  16.   ;;搜索最小长度的那一段
  17.   (foreach x PtsLst1
  18.     (if        (< (setq LinLeng (apply 'distance x)) MinLeng)
  19.       (setq MinLeng LinLeng
  20.             PtsLst2 x
  21.       )
  22.     )
  23.   )
  24.   ;;最小长度那一段的前一点
  25.   (setq        Pnt0        (car PtsLst2)
  26.         ;;最小长度那一段的后一点
  27.         Pnt1        (cadr PtsLst2)
  28.         ;;最小长度那一段的中点
  29.         Pnt2        (mapcar '* (mapcar '+ Pnt0 Pnt1) '(0.5 0.5 0.5))
  30.         PtsLst0        (append        (member Pnt0 PtsLst0)
  31.                         (reverse (cdr (member Pnt0 (reverse PtsLst0))))
  32.                 )
  33.         ;;循环后置,将Pnt0、Pnt1两点放在点表的后面
  34.         PtsLst0        (append (cddr PtsLst0) PtsLst2)
  35.         ;;初始化变量Pnt3
  36.         Pnt3        Pnt1
  37.         ;;初始化变量PtsLst1,这个变量按顺序保存将要绘制的多段线的所有点
  38.         PtsLst1        (list Pnt2)
  39.         ;;修复部分
  40.         Pnt4    (car PtsLst0)
  41.         Pnt5    (polar Pnt2 (angle Pnt3 Pnt4) (* MinLeng 0.25))
  42.   )
  43.   (if (setq LinLeng (bpoly Pnt5))
  44.     (if        (= (vlax-curve-getarea LinLeng)
  45.            (vlax-curve-getarea PLEntName)
  46.         )
  47.       (entdel LinLeng)
  48.       (progn
  49.         (entdel LinLeng)
  50.         (setq PtsLst0 (reverse PtsLst0)
  51.               PtsLst0 (append (cddr PtsLst0) (list Pnt1 Pnt0))
  52.               Pnt3    Pnt0
  53.               Pnt0    Pnt1
  54.         )
  55.       )
  56.     )
  57.     (setq PtsLst0 (reverse PtsLst0)
  58.           PtsLst0 (append (cddr PtsLst0) (list Pnt1 Pnt0))
  59.           Pnt3          Pnt0
  60.           Pnt0          Pnt1
  61.     )
  62.   )
  63.   ;;如果相对起点Pnt3是最小长度那一段的前一点,那么停止循环
  64.   (while (not (equal Pnt3 Pnt0))
  65.     ;;获取相对终点Pnt4
  66.     (setq Pnt4 (car PtsLst0)
  67.           ;;点Pnt5和点Pnt4一起使用,作为前进或后退的方向
  68.           Pnt5 (cadr PtsLst0)
  69.           ;;根据相对起点Pnt3和相对终点Pnt4的长度和方向移动点Pnt2
  70.           Pnt2 (polar Pnt2 (angle Pnt3 Pnt4) (distance Pnt3 Pnt4))
  71.     )
  72.     ;;如果移动后点Pnt2在原多段线上,那么先在Pnt3 Pnt4方向上后退半个最小长度,再在Pnt4 Pnt5方向上后退半个最小长度;
  73.     ;;相反地,点Pnt2不在原多段线上,那么先在Pnt3 Pnt4方向上前进半个最小长度,再在Pnt4 Pnt5方向上前进半个最小长度。
  74.     ;;这么做的目的是始终使点Pnt2和下一次循环的相对起点保持对齐,距离是半个最小长度,并把两次调整过的点存储到PtsLst1表中。
  75.     (if (vlax-curve-getParamAtPoint PLEntName Pnt2)
  76.       (setq Pnt2    (polar Pnt2 (angle Pnt4 Pnt3) (* MinLeng 0.5))
  77.             PtsLst1 (cons Pnt2 PtsLst1)
  78.             Pnt2    (polar Pnt2 (angle Pnt5 Pnt4) (* MinLeng 0.5))
  79.             PtsLst1 (cons Pnt2 PtsLst1)
  80.       )
  81.       (setq Pnt2    (polar Pnt2 (angle Pnt3 Pnt4) (* MinLeng 0.5))
  82.             PtsLst1 (cons Pnt2 PtsLst1)
  83.             Pnt2    (polar Pnt2 (angle Pnt4 Pnt5) (* MinLeng 0.5))
  84.             PtsLst1 (cons Pnt2 PtsLst1)
  85.       )
  86.     )
  87.     ;;设置下一次循环的相对起点为这次的相对终点
  88.     ;;并移除点表的第一项
  89.     (setq Pnt3          Pnt4
  90.           PtsLst0 (cdr PtsLst0)
  91.     )
  92.   )
  93.   (setq PtsLst1 (reverse PtsLst1)
  94.         ;;给顶点添加组码10
  95.         PtsLst1 (mapcar '(lambda (x) (cons 10 x)) PtsLst1)
  96.         ;;计算顶点的个数
  97.         PtsLst2 (length PtsLst1)
  98.         ;;添加多段线各段的起点宽度和终点宽度
  99.         PtsLst1 (mapcar '(lambda (x) (list (cons 40 MinLeng) (cons 41 MinLeng) x)) PtsLst1)
  100.         PtsLst1 (cddr (apply 'append PtsLst1))
  101.         )
  102.   ;;绘制多段线
  103.   (entmake
  104.     (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (100 . "AcDbPolyline") (8 . "0") (62 . 6) (70 . 0))
  105.             (list (cons 90  PtsLst2))
  106.             PtsLst1
  107.     )
  108.   )
  109.   (princ)
  110. )
回复

使用道具 举报

发表于 2013-4-6 08:38 | 显示全部楼层
试了一下,果然好使,多谢了
回复

使用道具 举报

发表于 2013-4-7 19:49 | 显示全部楼层
不知道严兄还有什么更好的方法?
回复

使用道具 举报

发表于 2013-7-14 17:11 | 显示全部楼层
整了半天,弄到LSP文件中,调用不了~初学者~
回复

使用道具 举报

发表于 2013-11-22 21:00 | 显示全部楼层
nzl1116 发表于 2013-4-5 10:37

话说,这个程序能指导下小白怎么使么?谢谢!
回复

使用道具 举报

发表于 2013-11-23 00:15 | 显示全部楼层
本帖最后由 nzl1116 于 2013-11-23 00:24 编辑
freeok 发表于 2013-11-22 21:00
话说,这个程序能指导下小白怎么使么?谢谢!


(PLConvert (car (entsel)))
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-3-28 21:07 , Processed in 0.272719 second(s), 19 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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