转换多段线 - AutoLISP/Visual LISP 编程技术 - AutoCAD论坛 - 明经CAD社区 - 第2页

print1985 发表于 2013-4-4 22:29:31

敢问楼主转换为pl线的目的是？

nzl1116 发表于 2013-4-5 08:48:20

仅支持闭合多段线
(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))))
)
PtsLst0 (append (cddr PtsLst0) PtsLst2)
Pnt3 Pnt1
PtsLst1 (list Pnt2)
)
(while (not (equal Pnt3 Pnt0))
(setq Pnt4 (car PtsLst0)
   Pnt5 (cadr PtsLst0)
   Pnt2 (polar Pnt2 (angle Pnt3 Pnt4) (distance Pnt3 Pnt4))
)
(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)
   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
)
)
)

yjr111 发表于 2013-4-5 10:03:21

nzl1116 发表于 2013-4-5 08:48 static/image/common/back.gif
仅支持闭合多段线

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

nzl1116 发表于 2013-4-5 10:10:53

yjr111 发表于 2013-4-5 10:03 static/image/common/back.gif
很棒，不过有些情况会出错，比如下面简单图形

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

nzl1116 发表于 2013-4-5 10:37:40

(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))
)
(if (setq LinLeng (bpoly Pnt5))
(if (= (vlax-curve-getarea LinLeng)
   (vlax-curve-getarea PLEntName)
)
   (entdel LinLeng)
   (progn
(entdel LinLeng)
(setq PtsLst0 (reverse PtsLst0)
      PtsLst0 (append (cddr PtsLst0) (list Pnt1 Pnt0))
      Pnt3 Pnt0
      Pnt0 Pnt1
)
   )
)
(setq PtsLst0 (reverse PtsLst0)
   PtsLst0 (append (cddr PtsLst0) (list Pnt1 Pnt0))
   Pnt3    Pnt0
   Pnt0    Pnt1
)
)
;;如果相对起点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)
)

ps122hb 发表于 2013-4-6 08:38:20

试了一下，果然好使，多谢了

xiaxiang 发表于 2013-4-7 19:49:24

不知道严兄还有什么更好的方法？

开1心 发表于 2013-7-14 17:11:58

整了半天，弄到LSP文件中，调用不了~初学者~

freeok 发表于 2013-11-22 21:00:22

nzl1116 发表于 2013-4-5 10:37 static/image/common/back.gif

话说，这个程序能指导下小白怎么使么？谢谢！

nzl1116 发表于 2013-11-23 00:15:12

本帖最后由 nzl1116 于 2013-11-23 00:24 编辑

freeok 发表于 2013-11-22 21:00 http://bbs.mjtd.com/static/image/common/back.gif
话说，这个程序能指导下小白怎么使么？谢谢！

(PLConvert (car (entsel)))

页: 1 [2] 3

明经CAD社区's Archiver