转换多段线
要求将封闭的无线宽的多段线转换成带线宽的多段线，如下图上面的也不行，还是这样好
(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 90PtsLst2))
PtsLst1
)
)
(princ)
) 本帖最后由 zzc83 于 2013-4-4 10:04 编辑
这个思路怎么和我的那么像。。。
只会简单的CAD操作
1 分解，
2删除小线条，
3生成中心线
4中心线加粗
记得G版主有个大作http://bbs.mjtd.com/thread-96463-1-1.html 搞个框选填充，哈哈 初步方案，效果大致如此 真的有点难搞，现在上传一些难一点的典型形状
这样行不行？
寻找最长线段，其他线段都是垂直这跟线的。 以短线中心线向下延伸 批量填充就能搞定