在p上创建直线
你好我参考了随附的由等距线段组成的多段线草图。我需要一个lisp文件，将最适合直线到多段线。随附的是两条多段线的图纸。洋红色多段线应采用lisp例程，最好用直线拟合。
谢谢
BSimpson公司
多段线到多段线。pdf
长截面1。图纸 以下是我写的内容-创建最适合选定二维多段线的绿线：
;;-------------------=={ List Difference }==------------------;;
;; ;;
;;Returns items appearing exclusively in one list but not ;;
;;another, i.e. the relative complement: l1 \ l2 ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;l1,l2 - lists for which to return the difference ;;
;;------------------------------------------------------------;;
;;Returns:List of items appearing exclusively in list l1;;
;;------------------------------------------------------------;;
(defun LM:ListDifference ( l1 l2 )
(vl-remove-if '(lambda ( x ) (member x l2)) l1)
)
(defun prelst ( lst el / f )
(vl-remove-if '(lambda ( a ) (or f (setq f (equal a el 1e-))) lst)
)
(defun suflst ( lst el )
(cdr (vl-member-if '(lambda ( a ) (equal a el 1e-) lst))
)
(defun c:plbestfit ( / osm q ss pl vert pt ptlst anglst danglst uanglst nths ptlstn p1 p2 p3 p4 p linplst sss )
(setq osm (getvar 'osmode))
(setvar 'osmode 0)
(prompt "\nPick 2d polyline")
(setq q T)
(while q
(setq ss (ssget "_+.:E:S:L" '((0 . "*POLYLINE"))))
(if ss
(if (eq (cdr (assoc 100 (reverse (entget (ssname ss 0))))) "AcDb3dPolyline") (setq q T) (setq q nil))
(setq q nil)
)
)
(if (eq (cdr (assoc 0 (entget (setq pl (ssname ss 0))))) "POLYLINE")
(progn
(setq vert (entnext pl))
(setq pt (cdr (assoc 10 (entget vert))))
(setq ptlst (cons pt ptlst))
(while (eq (cdr (assoc 0 (entget (setq vert (entnext vert))))) "VERTEX")
(setq pt (cdr (assoc 10 (entget vert))))
(setq ptlst (cons pt ptlst))
)
(setq ptlst (reverse ptlst))
)
)
(if (eq (cdr (assoc 0 (entget (setq pl (ssname ss 0))))) "LWPOLYLINE")
(progn
(command "_.convertpoly" "H" pl "")
(setq vert (entnext pl))
(setq pt (cdr (assoc 10 (entget vert))))
(setq ptlst (cons pt ptlst))
(while (eq (cdr (assoc 0 (entget (setq vert (entnext vert))))) "VERTEX")
(setq pt (cdr (assoc 10 (entget vert))))
(setq ptlst (cons pt ptlst))
)
(setq ptlst (reverse ptlst))
(command "_.convertpoly" "L" pl "")
)
)
(setq ptlst (acet-list-remove-duplicates ptlst 1e-2))
(setq anglst (mapcar '(lambda (a b) (angle a b)) ptlst (cdr ptlst)))
(foreach ang anglst
(cond ((<= (* 1.5 pi) ang (* 2.0 pi)) (setq danglst (cons ang danglst)))
((<= 0.0 ang (* 0.5 pi)) (setq uanglst (cons ang uanglst)))
)
)
(setq danglst (reverse danglst) uanglst (reverse uanglst))
(defun nthsegang ( anglst danglst uanglst / seglst1 seg1ang s1 seglst2 seg2ang s2 )
(if (equal (car danglst) (car anglst) 1e- (setq seglst1 (prelst anglst (car uanglst))))
(if (equal (car uanglst) (car anglst) 1e- (setq seglst2 (prelst anglst (car danglst))))
(setq s1 (length seglst1) s2 (length seglst2))
(setq sss (+ (if (null sss) 0 sss) s1 s2))
(if seglst1 (setq seg1ang (car (vl-sort seglst1 '<=))))
(if seglst2 (setq seg2ang (car (vl-sort seglst2 '>=))))
(if seglst1 (setq danglst (LM:ListDifference danglst seglst1) anglst (LM:ListDifference anglst seglst1)))
(if seglst2 (setq uanglst (LM:ListDifference uanglst seglst2) anglst (LM:ListDifference anglst seglst2)))
(if seglst1 (if (null nths) (setq nths (cons (+ (length (prelst seglst1 seg1ang)) 1) nths)) (setq nths (cons (+ sss (- s1) (- s2) (length (prelst seglst1 seg1ang)) 1) nths))))
(if seglst2 (if (null nths) (setq nths (cons (+ (length (prelst seglst2 seg2ang)) 1) nths)) (setq nths (cons (+ sss (- s1) (- s2) (length (prelst seglst2 seg2ang)) 1) nths))))
(if anglst (nthsegang anglst danglst uanglst))
nths
)
(setq nths (reverse (nthsegang anglst danglst uanglst)))
(foreach n nths
(setq ptlstn (cons (nth (- n 1) ptlst) ptlstn) ptlstn (cons (nth n ptlst) ptlstn))
)
(setq ptlstn (reverse ptlstn))
(while (> (length ptlstn) 2)
(setq p1 (car ptlstn) p2 (cadr ptlstn) p3 (caddr ptlstn) p4 (cadddr ptlstn))
(setq p (inters p1 p2 p3 p4 nil))
(setq linplst (cons p linplst))
(setq ptlstn (cddr ptlstn))
)
(setq linplst (reverse linplst))
(while (> (length linplst) 1)
(setq p1 (car linplst) p2 (cadr linplst))
(entmake (list '(0 . "LINE") '(62 . 3) (cons 10 p1) (cons 11 p2)))
(setq linplst (cdr linplst))
)
(setvar 'osmode osm)
(princ)
)
或者，您可以将直线转换为多段线-pedit、multiple、select lines、join。。。
M、 R。 你好，Marco_ribar，
lisp工作得很好，但当我尝试更长的多段线时，我得到了以下错误消息；
选择对象：找到1个
选择对象：转换1个多段线对象。
命令：_。convertpoly输入多段线转换选项[重/轻]：L
选择对象：找到1个
选择对象：转换1个多段线对象。
命令：发生硬错误***
达到内部堆栈限制（模拟）
页:
[1]