如何把一段折线(pline)展开成相同延长度的直线(pline)?

alex0007 · 发表于 2012-6-13 15:55:06

补充图片说明.并附CAD图,不知有没有类似的lsp?求大招.

llsheng_73 · 发表于 2022-7-18 19:31:54

(defun makepl(arg);;arg==>(list pts 闭合标志全局宽度线宽图层颜色厚度线型)pts以后可省略
(entmakex(append(mapcar'cons'(0 100 100 43 370 8 62 39 6)(append'("LWPOLYLINE""AcDbEntity""AcDbPolyline")(cddr arg)))
(cons(cons 90(length(car arg)))(cons(cons 70(if(cadr arg)(cadr arg)0))(mapcar'(lambda(x)(cons 10 x))(car arg)))))))
(defun c:tt(/ e p l)
(while(and(setq l nil e(car(entsel"选择需要展开的曲线")))
(setq n(VL-CATCH-ALL-APPLY'vlax-curve-getendparam(list e)))
(setq p(getpoint"指定展开线起点:")))
(cond((WCMATCH(cdr(assoc 0(entget e)))"*POLYLINE")
(while(setq p(vlax-curve-getdistatparam e n))
(setq l(cons(polar p 0(vlax-curve-getdistatparam e n))l)n(1- n)))
(makepl(List l)))
(t(makepl(list(list p(polar p 0(-(vlax-curve-getdistatparam e(vlax-curve-getendparam e))(vlax-curve-getdistatparam e(vlax-curve-getstartparam e)))))))))))

tfanghui · 发表于 2022-7-18 00:09:41

langjs 发表于 2012-6-14 09:12
对LWPOLYLINE和POLYLINE都有效

大神，这个代码可以给定一个高度，再连接上下每条线段的端点吗

alex0007 · 发表于 2012-6-13 20:07:42

展开线啊.没有人关注吗?顶上

langjs · 发表于 2012-6-13 21:28:42

(defun c:aa (/ d ent lst name p0 p1 p2 pt1 pt2 pt3 ss txt x)
  (defun dim (pt1 pt2 / d p0 txt)
(setq d (distance pt1 pt2) txt (rtos d) p2 (polar p1 0.0 d)  p0 (polar p1 0.0 (* 0.5 d)))
(entmake (list '(0 . "LINE") (cons 62 3) (cons 10 p1) (cons 11 p2)))
(entmake (list '(0 . "TEXT") (cons 62 2) (cons 10 p0) (cons 40 300) (cons 1 txt) '(41 . 0.8) '(72 . 1) ;字高300
               (cons 11 p0) '(73 . 0)  ) )
(setq p1 p2)
  )
  (setvar "cmdecho" 0)
  (vl-load-com)
  (setq ss (ssget ":E:S" '((0 . "LWPOLYLINE"))))
  (setq p1 (getpoint "指定基点")  name (ssname ss 0) ent (entget name) lst nil )
  (foreach x ent
(if (= (car x) 10) (setq lst (cons (cdr x) lst)))
  )
  (setq lst (reverse lst) pt1 nil pt2 nil )
  (foreach x lst
(if (null pt1)(setq pt1 x pt3 x )(setq pt2 x))
(if pt2 (progn (dim pt1 pt2) (setq pt1 pt2)))
  )
  (if (= 1 (cdr (assoc 70 ent))) (dim pt2 pt3))
  (princ)
)

alex0007 · 发表于 2012-6-13 22:42:17

谢谢楼上的..只对LWPOLYLINE有效..如果是POLYLINE就要自己先(CONVERTPOLY)转换了..万分感谢!!

alex0007 · 发表于 2012-6-13 22:51:53

可以,有了线变成pline也是很容易的事.楼下已完成,试用过有效,感谢.

langjs · 发表于 2012-6-14 09:12:56

alex0007 发表于 2012-6-13 22:42
谢谢楼上的..只对LWPOLYLINE有效..如果是POLYLINE就要自己先(CONVERTPOLY)转换了..万分感谢!!

对LWPOLYLINE和POLYLINE都有效

(defun c:aa ( / d ent j n name p0 p1 p2 pt1 pt2 pt3 ptslist ss txt vtxlst x)
  (defun dim (pt1 pt2 / d p0 txt)
(setq d (distance pt1 pt2) txt (rtos d) p2 (polar p1 0.0 d) p0 (polar p1 0.0 (* 0.5 d)) )
(entmake (list '(0 . "LINE") (cons 62 3) (cons 10 p1) (cons 11 p2)))
(entmake (list '(0 . "TEXT") (cons 62 2) (cons 10 p0) (cons 40 300) (cons 1 txt) '(41 . 0.8) '(72 . 1) ; 字高300
               (cons 11 p0) '(73 . 0)) )
(setq p1 p2)
  )
  (setvar "cmdecho" 0)
  (vl-load-com)
  (setq ss (ssget ":E:S" '((0 . "LWPOLYLINE,POLYLINE"))))
  (setq p1 (getpoint "指定基点")  name (ssname ss 0)  ent (entget name)  ptslist nil  j 0 )
  (if (= "LWPOLYLINE" (cdr (assoc 0 ent)))  (setq n 2)  (setq n 3))
  (setq vtxlst (vlax-safearray->list (vlax-variant-value (vlax-get-property (vlax-ename->vla-object name) 'coordinates))))
  (repeat (/ (length vtxlst) n)
(setq ptslist(append ptslist (list (list (nth j vtxlst) (nth (1+ j) vtxlst) (if (= n 3)(nth (+ 2 j) vtxlst)  0.0 )))))
(setq j (+ j n))
  )
  (setq pt1 nil pt2 nil )
  (foreach x ptslist
(if (null pt1) (setq pt1 x  pt3 x ) (setq pt2 x))
(if pt2 (progn (dim pt1 pt2) (setq pt1 pt2)))
  )
  (if (= 1 (cdr (assoc 70 ent))) (dim pt2 pt3))
  (princ)
)

flytoday · 发表于 2012-6-14 09:51:22

这个非常好。。希望增加弧线也能展开。让程序最完美~

flytoday · 发表于 2012-6-14 10:06:51

希望展开后断点插入一直线~~

ljpnb · 发表于 2012-6-14 10:58:46

flytoday 发表于 2012-6-14 10:06
希望展开后断点插入一直线~~

6楼的程序稍稍加了几句

sdls · 发表于 2019-8-5 22:23:35

楼上的文件，不能下载！！

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

如何把一段折线(pline)展开成相同延长度的直线(pline)?

本帖子中包含更多资源

点评

相关帖子

评分

本帖子中包含更多资源

点评

本帖子中包含更多资源

评分