谢谢你的回答。但是sortpoints函数似乎不起作用。我用样本数据在代码中尝试了这个函数。
样本数据是多段线的顶点。我混合了顶点的顺序，我希望你的函数（sortpoints）对这些点进行排序。但它给了我相同的分数顺序。也许是我的错。
以下是采样点（多段线的顶点）
(370961.248 310947.465) ;1.
(371118.717 311119.493) ;2.
(371016.444 311267.177) ;3.
(371083.002 311526.843) ;4.
(371232.353 311705.362) ;5.
(370930.404 311919.585) ;6.
以下是完整代码：
- (vl-load-com)
- ;*
- ;* NK_FINT : Find intersection points
- ;* (intersections points of selected polyline with lines)
- ;*
- (defun C:nk_fint (/ plObj line_ss int_ss intP inc ent verts ptList)
- (setq
- plObj (vlax-ename->vla-object (car (entsel "\nSelect Polyline: "))); = Polyline OBJect
- line_ss (ssget "_X" '((0 . "LINE"))); = Line Selection Set
- int_ss (ssadd); = things that intersect -- start empty
- inc -1
- ); setq
- (setq ptList '(
- ;(370961.248 310947.465) ;1
- (371118.717 311119.493) ;2
- (371016.444 311267.177) ;3
- (370961.248 310947.465) ;1
- (371083.002 311526.843) ;4
- (371232.353 311705.362) ;5
- (370930.404 311919.585) ;6
- )
- )
- (princ "\n\Before: \n")
- (writepoints ptList) ;for testing purpose
- (repeat (sslength line_ss)
- (setq ent (ssname line_ss (setq inc (1+ inc)))); = line ENTity
- (if
- (setq intP ; intersection point
- (vlax-invoke plObj 'intersectWith (vlax-ename->vla-object ent) acExtendNone); vlax-invoke
- ); setq
- (progn
- (setq verts (getverts plObj intP))
- (princ "\nVerts:\n") (writepoints verts) ;for testing purpose
- (ssadd ent int_ss)
- ) ; progn
- ); if
- ); repeat
- (sortpoints plObj ptList)
- (princ "\n\nAfter: \n")
- (writepoints ptList) ;for testing purpose
- (princ)
- ); defun
- ;*
- ;* WRITEPOINTS: write points (test-purpose)
- ;*
- (defun writepoints ( plst / x1 y1 ptmp)
- (while (setq ptmp (car plst))
- (princ (rtos (car ptmp) 2 3))(princ " ")(princ (rtos (cadr ptmp) 2 3))(princ "\n")
- (setq plst (cdr plst))
- )
- (princ)
- )
- ;*
- ;* SORTPOINTS: sorts given points along with selected polyline
- ;*
- (defun sortpoints ( ent lst )
- (vl-sort lst
- (function
- (lambda ( a b )
- (< (vlax-curve-getparamatpoint ent a)
- (vlax-curve-getparamatpoint ent b)
- )
- )
- )
- )
- )
- ;*
- ;* GETVERTS: Gives vertex points of selected Polyline.
- ;*
- (defun getverts (pObj iPt / PtOnObj DistPick DistV1 PtV1 VNum distFlag DistV2 PtV2)
- (setq PtOnObj (vlax-curve-getClosestPointTo pObj iPt))
- (setq DistPick (vlax-curve-getDistatPoint pObj PtOnObj))
- (setq DistV1 0.0)
- (setq PtV1 (vlax-curve-getPointatparam pObj 0));;Pl start point
- (setq VNum 1.0)
- (setq distFlag T)
- (while distFlag
- (setq DistV2 (vlax-curve-getDistatParam pObj Vnum))
- (setq PtV2 (vlax-curve-getPointatParam pObj Vnum))
- (if (> DistV2 DistPick)
- (setq DistFlag nil)
- (setq Vnum (+ 1 Vnum) PtV1 PtV2)
- )
- )
- (list PtV1 PtV2);;returns list of 2 vertices bounding pick point
- )
谢谢 | 
置顶卡
