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

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

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

yqscves25mw.jpg

本帖以下内容被隐藏保护；需要你回复后，才能看到！

游客，如果您要查看本帖隐藏内容请回复

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

(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:00

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

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

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

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

(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:00

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

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

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

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

对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)
)