悬赏5个明经币，自己写的烂尾程序求优化！！！（ljb制作）
本帖最后由 水吉空 于 2018-1-15 13:35 编辑忍无可忍，无须再忍！此人小人一个，2017年10月份要我帮忙给他一个批量插图插件，该插件是我自己独立完成的。当时我拒绝了他，然后他立马翻脸。事情本来过去2个月了，我以为我们个过个的生活，没想到此人如此记仇，睚眦必报，从2017年10月份至今，一直在论坛拿私人恩怨搞事，现在在明经论坛，只要是我的帖子，就有他的恶意评论！到处造谣生事，请求版主、明总执法，那怕把我也封号了我也认了。我在群里已经说得很明白了，视频我分享给我的朋友，或者说是我学生。说假话不得好死。至于你，呵呵，不给帮忙就翻脸，过去2个月了，小人一个。
悬赏5个明经币，自己写的烂尾程序求优化！！！
主要是实现多段线拐点的自动连接。（ljb制作）
目的：探讨学习，优化以及实现多段线拐点的自动连接的通用性。
主要是算法，点集的算法优化！！！谢谢大神了！！！
[*](defun ljb-jc-plinexy (e / a q m p)
[*](setq a(vlax-ename->vla-object e)
[*] q(vlax-safearray->list(vlax-variant-value(vla-get-Coordinates a)))
[*] m(vla-get-objectname a)
[*] a 0
[*] m(if (= m "AcDb3dPolyline")3 2))
[*](repeat(/ (length q) m)
[*] (cond((= m 2)(setq p1 (list(nth a q) (nth(+ a 1)q))))
[*] ((= m 3)(setq p1(list(nth a q)(nth(+ a 1)q)(nth(+ a 2)q)))))
[*] (setq p(if(member p1 p)p(append p(list p1)))
[*] a(+ a m)))
[*]p)
[*](defun fsort (e1 e2)
[*](if (= (car e1) (car e2))
[*] (< (cadr e1) (cadr e2))
[*] (< (car e1) (car e2))
[*])
[*])
[*](defun BF-list-same (lst)
[*](if lst
[*] (if (member (car lst) (cdr lst))
[*] (cons (car lst) (BF-list-same (vl-remove (car lst) (cdr lst))))
[*] (BF-list-same (vl-remove (car lst) (cdr lst)))
[*] )
[*])
[*])
[*](defun ljb-list-same (lst)
[*](if lst
[*] (if (member (car lst) (cdr lst))
[*] (cons (car lst) (BF-list-same (vl-remove (car lst) (cdr lst))))
[*] (BF-list-same (vl-remove (car lst) (cdr lst)))
[*] )
[*])
[*])
[*](defun ljb-List-ReplaceIndex (oldlst index item)
[*](if (zerop index)
[*] (append (list item) (cdr oldlst))
[*] (cons (car oldlst)
[*] (BF-list-replaceindex (cdr oldlst) (1- index) item)
[*] )
[*])
[*])
[*]
[*](defun BF-List-ReplaceIndex (oldlst index item)
[*](if (zerop index)
[*] (append (list item) (cdr oldlst))
[*] (cons (car oldlst)
[*] (BF-list-replaceindex (cdr oldlst) (1- index) item)
[*] )
[*])
[*])
[*](defun ljb-tf (lst / po_last_lst po_last_lst_1 qc_lst temp_lst temp_lst4 temp_lst5 y)
[*](setq po_last_lst (vl-sort lst 'fsort))
[*](setq qc_lst (ljb-list-same po_last_lst))
[*](setq y 0)
[*](repeat (length qc_lst)
[*] (setq temp_lst (nth y qc_lst))
[*] (setq po_last_lst (vl-remove temp_lst po_last_lst))
[*] (setq y (1+ y))
[*])
[*](setq po_last_lst_1 (append qc_lst po_last_lst))
[*](setq po_last_lst_1 (vl-sort po_last_lst_1 'fsort))
[*](setq temp_lst4 (nth 4 po_last_lst_1))
[*](setq temp_lst5 (nth 5 po_last_lst_1))
[*](setq po_last_lst_1 (ljb-List-ReplaceIndex po_last_lst_1 5 temp_lst4))
[*](setq po_last_lst_1 (ljb-List-ReplaceIndex po_last_lst_1 4 temp_lst5))
[*](progn (command "_.PLINE")
[*] (foreach n po_last_lst_1 (command n))
[*] (command ""))
[*])
[*](defun c:tf (/ *acad* *doc* *error* cecolor_bak celtype_bak clayer_bak ename ename1 entmakelst first i i1 osmode_bak po_lst po_lst_lst s ss ss1 textstyle_bak)
[*](vl-load-com)
[*](setq *ACAD*(vlax-get-acad-object)
[*] *DOC* (vla-get-ActiveDocument *ACAD*)
[*])
[*](defun *error* (msg)
[*] (vlax-invoke-method *DOC* 'EndUndoMark)
[*] (princ msg)
[*] (princ)
[*])
[*](vlax-invoke-method *DOC* 'StartUndoMark)
[*](setvar "cmdecho" 0)
[*](setq osmode_bak (getvar "osmode"))
[*](setvar "osmode" 0)
[*](setq clayer_bak (getvar "clayer"))
[*](setq cecolor_bak (getvar "cecolor"))
[*](setq celtype_bak (getvar "celtype"))
[*](setq textstyle_bak (getvar "textstyle"))
[*](setq ss (ssget))
[*](setq po_lst_lst nil)
[*](repeat (setq i (sslength ss))
[*] (setq ename (ssname ss (setq i (1- i))))
[*] (cond ((and (= (Vlax-Get (Vlax-Ename->Vla-Object ename) 'ObjectName ) "AcDbPolyline")
[*] (or (= (length (Vlax-Get (Vlax-Ename->Vla-Object ename) 'Coordinates )) 4) (= (length (Vlax-Get (Vlax-Ename->Vla-Object ename) 'Coordinates )) 6)))
[*] (progn (setq po_lst (ljb-jc-plinexy ename))
[*] (setq po_lst_lst (append po_lst po_lst_lst))
[*] ))
[*] ((= (Vlax-Get (Vlax-Ename->Vla-Object ename) 'ObjectName ) "AcDbBlockReference")
[*] (progn
[*] (setq entmakelst (entget ename))
[*] (setq ss1 (ssadd))
[*] (setq first (entlast))
[*] (command "_.EXPLODE" ename "")
[*] (while
[*] (setq s (entnext first))
[*] (setq ss1 (ssadd s ss1) first (entnext first))
[*] )
[*] (repeat (setq i1 (sslength ss1))
[*] (setq ename1 (ssname ss1 (setq i1 (1- i1))))
[*] (if (and (= (Vlax-Get (Vlax-Ename->Vla-Object ename1) 'ObjectName ) "AcDbPolyline")
[*] (or (= (length (Vlax-Get (Vlax-Ename->Vla-Object ename1) 'Coordinates )) 4) (= (length (Vlax-Get (Vlax-Ename->Vla-Object ename1) 'Coordinates )) 6)))
[*] (progn (setq po_lst (ljb-jc-plinexy ename1))
[*] (setq po_lst_lst (append po_lst po_lst_lst))
[*] )
[*] )
[*] (entdel ename1)
[*] )
[*] )
[*] ))
[*])
[*](if entmakelst
[*] (progn
[*] (entmake entmakelst))
[*])
[*](ljb-tf po_lst_lst)
[*](setvar "osmode" osmode_bak)
[*](setvar "clayer" clayer_bak)
[*](setvar "cecolor" cecolor_bak)
[*](setvar "celtype" celtype_bak)
[*](setvar "textstyle" textstyle_bak)
[*](setvar "cmdecho" 1)
[*](vlax-invoke-method *DOC* 'EndUndoMark)
[*](princ)
[*])