转换多段线

yjr111 · 发表于 2013-4-4 09:26:54

要求将封闭的无线宽的多段线转换成带线宽的多段线，如下图

nzl1116 · 发表于 2013-4-4 09:26:55

上面的也不行，还是这样好

(defun PLConvert (PLEntName / PtsLst0 PtsLst1 MinLeng LinLeng PtsLst2 Pnt0 Pnt1 Pnt2 Pnt3 Pnt4 Pnt5)
;;获取闭合多段线所有顶点的坐标
(setq PtsLst0 (mapcar 'cdr
(vl-remove-if
'(lambda (x) (/= 10 (car x)))
(entget PLEntName)
)
)
;;将起点后置
PtsLst1 (append (cdr PtsLst0) (list (car PtsLst0)))
;;初始化最小长度为闭合多段线的总长
MinLeng (apply '+ (mapcar 'distance PtsLst1 PtsLst0))
;;获取多段线每一段的点对表
PtsLst1 (mapcar 'list PtsLst0 PtsLst1)
)
;;搜索最小长度的那一段
(foreach x PtsLst1
(if (< (setq LinLeng (apply 'distance x)) MinLeng)
(setq MinLeng LinLeng
PtsLst2 x
)
)
)
;;最小长度那一段的前一点
(setq Pnt0 (car PtsLst2)
;;最小长度那一段的后一点
Pnt1 (cadr PtsLst2)
;;最小长度那一段的中点
Pnt2 (mapcar '* (mapcar '+ Pnt0 Pnt1) '(0.5 0.5 0.5))
PtsLst0 (append (member Pnt0 PtsLst0)
(reverse (cdr (member Pnt0 (reverse PtsLst0))))
)
;;循环后置，将Pnt0、Pnt1两点放在点表的后面
PtsLst0 (append (cddr PtsLst0) PtsLst2)
;;初始化变量Pnt3
Pnt3 Pnt1
;;初始化变量PtsLst1，这个变量按顺序保存将要绘制的多段线的所有点
PtsLst1 (list Pnt2)
;;修复部分
Pnt4 (car PtsLst0)
Pnt5 (polar Pnt2 (angle Pnt3 Pnt4) (* MinLeng 0.25))
LinLeng nil
)
(if (and (setq LinLeng (bpoly Pnt5))
(equal (vlax-curve-getarea LinLeng)
(vlax-curve-getarea PLEntName)
0.00001
)
)
nil
(progn
(setq Pnt2 (polar Pnt2 (angle Pnt5 Pnt2) (* MinLeng 0.5))
PtsLst1 (cons Pnt2 PtsLst1)
Pnt2 (polar Pnt2 (angle Pnt0 Pnt1) MinLeng)
PtsLst1 (cons Pnt2 PtsLst1)
Pnt2 (polar Pnt2 (angle Pnt3 Pnt4) (* MinLeng 0.5))
PtsLst1 (cons Pnt2 PtsLst1)
)
)
)
(if LinLeng (entdel LinLeng))
;;如果相对起点Pnt3是最小长度那一段的前一点，那么停止循环
(while (not (equal Pnt3 Pnt0))
;;获取相对终点Pnt4
(setq Pnt4 (car PtsLst0)
;;点Pnt5和点Pnt4一起使用，作为前进或后退的方向
Pnt5 (cadr PtsLst0)
;;根据相对起点Pnt3和相对终点Pnt4的长度和方向移动点Pnt2
Pnt2 (polar Pnt2 (angle Pnt3 Pnt4) (distance Pnt3 Pnt4))
)
;;如果移动后点Pnt2在原多段线上，那么先在Pnt3 Pnt4方向上后退半个最小长度，再在Pnt4 Pnt5方向上后退半个最小长度；
;;相反地，点Pnt2不在原多段线上，那么先在Pnt3 Pnt4方向上前进半个最小长度，再在Pnt4 Pnt5方向上前进半个最小长度。
;;这么做的目的是始终使点Pnt2和下一次循环的相对起点保持对齐，距离是半个最小长度，并把两次调整过的点存储到PtsLst1表中。
(if (vlax-curve-getParamAtPoint PLEntName Pnt2)
(setq Pnt2 (polar Pnt2 (angle Pnt4 Pnt3) (* MinLeng 0.5))
PtsLst1 (cons Pnt2 PtsLst1)
Pnt2 (polar Pnt2 (angle Pnt5 Pnt4) (* MinLeng 0.5))
PtsLst1 (cons Pnt2 PtsLst1)
)
(setq Pnt2 (polar Pnt2 (angle Pnt3 Pnt4) (* MinLeng 0.5))
PtsLst1 (cons Pnt2 PtsLst1)
Pnt2 (polar Pnt2 (angle Pnt4 Pnt5) (* MinLeng 0.5))
PtsLst1 (cons Pnt2 PtsLst1)
)
)
;;设置下一次循环的相对起点为这次的相对终点
;;并移除点表的第一项
(setq Pnt3 Pnt4
PtsLst0 (cdr PtsLst0)
)
)
(setq PtsLst1 (reverse PtsLst1)
;;给顶点添加组码10
PtsLst1 (mapcar '(lambda (x) (cons 10 x)) PtsLst1)
;;计算顶点的个数
PtsLst2 (length PtsLst1)
;;添加多段线各段的起点宽度和终点宽度
PtsLst1 (mapcar '(lambda (x) (list (cons 40 MinLeng) (cons 41 MinLeng) x)) PtsLst1)
PtsLst1 (cddr (apply 'append PtsLst1))
)
;;绘制多段线
(entmake
(append '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (100 . "AcDbPolyline") (8 . "0") (62 . 6) (70 . 0))
(list (cons 90 PtsLst2))
PtsLst1
)
)
(princ)
)

(defun PLConvert (PLEntName / PtsLst0 PtsLst1 MinLeng LinLeng PtsLst2 Pnt0 Pnt1 Pnt2 Pnt3 Pnt4 Pnt5) 
  ;;获取闭合多段线所有顶点的坐标 
  (setq        PtsLst0        (mapcar        'cdr 
                        (vl-remove-if 
                          '(lambda (x) (/= 10 (car x))) 
                          (entget PLEntName) 
                        ) 
                ) 
        ;;将起点后置 
        PtsLst1        (append (cdr PtsLst0) (list (car PtsLst0))) 
        ;;初始化最小长度为闭合多段线的总长 
        MinLeng        (apply '+ (mapcar 'distance PtsLst1 PtsLst0)) 
        ;;获取多段线每一段的点对表 
        PtsLst1        (mapcar 'list PtsLst0 PtsLst1) 
  ) 
  ;;搜索最小长度的那一段 
  (foreach x PtsLst1 
    (if        (< (setq LinLeng (apply 'distance x)) MinLeng) 
      (setq MinLeng LinLeng 
            PtsLst2 x 
      ) 
    ) 
  ) 
  ;;最小长度那一段的前一点 
  (setq        Pnt0        (car PtsLst2) 
        ;;最小长度那一段的后一点 
        Pnt1        (cadr PtsLst2) 
        ;;最小长度那一段的中点 
        Pnt2        (mapcar '* (mapcar '+ Pnt0 Pnt1) '(0.5 0.5 0.5)) 
        PtsLst0        (append        (member Pnt0 PtsLst0) 
                        (reverse (cdr (member Pnt0 (reverse PtsLst0)))) 
                ) 
        ;;循环后置，将Pnt0、Pnt1两点放在点表的后面 
        PtsLst0        (append (cddr PtsLst0) PtsLst2) 
        ;;初始化变量Pnt3 
        Pnt3        Pnt1 
        ;;初始化变量PtsLst1，这个变量按顺序保存将要绘制的多段线的所有点 
        PtsLst1        (list Pnt2) 
        ;;修复部分 
        Pnt4    (car PtsLst0) 
        Pnt5    (polar Pnt2 (angle Pnt3 Pnt4) (* MinLeng 0.25)) 
        LinLeng nil 
  ) 
  (if (and (setq LinLeng (bpoly Pnt5)) 
           (equal (vlax-curve-getarea LinLeng) 
                  (vlax-curve-getarea PLEntName) 
                  0.00001 
           ) 
      ) 
    nil 
    (progn 
      (setq Pnt2    (polar Pnt2 (angle Pnt5 Pnt2) (* MinLeng 0.5)) 
            PtsLst1 (cons Pnt2 PtsLst1) 
            Pnt2    (polar Pnt2 (angle Pnt0 Pnt1) MinLeng) 
            PtsLst1 (cons Pnt2 PtsLst1) 
            Pnt2    (polar Pnt2 (angle Pnt3 Pnt4) (* MinLeng 0.5)) 
            PtsLst1 (cons Pnt2 PtsLst1) 
      ) 
    ) 
  ) 
  (if LinLeng (entdel LinLeng)) 
  ;;如果相对起点Pnt3是最小长度那一段的前一点，那么停止循环 
  (while (not (equal Pnt3 Pnt0)) 
    ;;获取相对终点Pnt4 
    (setq Pnt4 (car PtsLst0) 
          ;;点Pnt5和点Pnt4一起使用，作为前进或后退的方向 
          Pnt5 (cadr PtsLst0) 
          ;;根据相对起点Pnt3和相对终点Pnt4的长度和方向移动点Pnt2 
          Pnt2 (polar Pnt2 (angle Pnt3 Pnt4) (distance Pnt3 Pnt4)) 
    ) 
    ;;如果移动后点Pnt2在原多段线上，那么先在Pnt3 Pnt4方向上后退半个最小长度，再在Pnt4 Pnt5方向上后退半个最小长度； 
    ;;相反地，点Pnt2不在原多段线上，那么先在Pnt3 Pnt4方向上前进半个最小长度，再在Pnt4 Pnt5方向上前进半个最小长度。 
    ;;这么做的目的是始终使点Pnt2和下一次循环的相对起点保持对齐，距离是半个最小长度，并把两次调整过的点存储到PtsLst1表中。 
    (if (vlax-curve-getParamAtPoint PLEntName Pnt2) 
      (setq Pnt2    (polar Pnt2 (angle Pnt4 Pnt3) (* MinLeng 0.5)) 
            PtsLst1 (cons Pnt2 PtsLst1) 
            Pnt2    (polar Pnt2 (angle Pnt5 Pnt4) (* MinLeng 0.5)) 
            PtsLst1 (cons Pnt2 PtsLst1) 
      ) 
      (setq Pnt2    (polar Pnt2 (angle Pnt3 Pnt4) (* MinLeng 0.5)) 
            PtsLst1 (cons Pnt2 PtsLst1) 
            Pnt2    (polar Pnt2 (angle Pnt4 Pnt5) (* MinLeng 0.5)) 
            PtsLst1 (cons Pnt2 PtsLst1) 
      ) 
    ) 
    ;;设置下一次循环的相对起点为这次的相对终点 
    ;;并移除点表的第一项 
    (setq Pnt3          Pnt4 
          PtsLst0 (cdr PtsLst0) 
    ) 
  ) 
  (setq PtsLst1 (reverse PtsLst1) 
        ;;给顶点添加组码10 
        PtsLst1 (mapcar '(lambda (x) (cons 10 x)) PtsLst1) 
        ;;计算顶点的个数 
        PtsLst2 (length PtsLst1) 
        ;;添加多段线各段的起点宽度和终点宽度 
        PtsLst1 (mapcar '(lambda (x) (list (cons 40 MinLeng) (cons 41 MinLeng) x)) PtsLst1) 
        PtsLst1 (cddr (apply 'append PtsLst1)) 
        ) 
  ;;绘制多段线 
  (entmake 
    (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (100 . "AcDbPolyline") (8 . "0") (62 . 6) (70 . 0)) 
            (list (cons 90  PtsLst2)) 
            PtsLst1 
    ) 
  ) 
  (princ) 
)

zzc83 · 发表于 2013-4-4 10:01:16

本帖最后由 zzc83 于 2013-4-4 10:04 编辑

这个思路怎么和我的那么像。。。
只会简单的CAD操作
1 分解，
2删除小线条，
3生成中心线
4中心线加粗

tianyi1230 · 发表于 2013-4-4 10:59:57

记得G版主有个大作http://bbs.mjtd.com/thread-96463-1-1.html

注册 · 发表于 2013-4-4 12:03:19

搞个框选填充，哈哈

yjr111 · 发表于 2013-4-4 16:42:43

初步方案，效果大致如此

yjr111 · 发表于 2013-4-4 18:40:24

真的有点难搞，现在上传一些难一点的典型形状

zzc83 · 发表于 2013-4-4 20:57:37

这样行不行？
寻找最长线段，其他线段都是垂直这跟线的。

杨光88888888 · 发表于 2013-4-4 21:11:42

以短线中心线向下延伸

flytoday · 发表于 2013-4-4 21:45:28

批量填充就能搞定

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

[源码] 转换多段线

最佳答案

点评

点评

点评

评分

点评

评分

本帖子中包含更多资源

本帖子中包含更多资源

点评

浏览过的版块