I use by ID for Point! However! It is as a little slower
(defun C:MinLength (/ ID1 ID2 IDEND IDSTART LISTPOINT LTSID LTSIDFIL LTSIDPNT
LTSID_EDGE LTSLINE LTSPATH LTSPNT LTSPNTALL OLMODE P1 P2
PNTEND PNTSTART SSLINE X
)
(vl-load-com)
(setvar "CMDECHO" 0)
(defun *error* (msg)
(if Olmode
(setvar 'osmode Olmode)
)
(if (not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
(princ (strcat "\nError: " msg))
)
(princ)
)
(setq Olmode (getvar 'osmode))
(Alert
"Qu\U+00E9t ch\U+1ECDn c\U+00E1c \U+0111\U+1ED1i t\U+01B0\U+1EE3ng l\U+00E0 LINE: "
)
(setq ssLine (ssget "_:L" (list (cons 0 "LINE"))))
(if ssLine
(Progn
(setvar 'osmode 1)
(setq PntStart
(getpoint
"\nCh\U+1ECDn \U+0111i\U+1EC3m xu\U+1EA5t ph\U+00E1t: "
)
)
(setq
PntEnd (getpoint
"\nCh\U+1ECDn \U+0111i\U+1EC3m \U+0111\U+1EBFn: "
)
)
(setq LtsLine (LM:ss->ent ssLine))
(setq LtsPntAll (list))
(foreach eLine LtsLine
(setq
LtsPntAll (append LtsPntAll
(list (cdr (assoc 10 (entget eLine)))
(cdr (assoc 11 (entget eLine)))
)
)
)
)
(setq LtsPnt (SortAB (LM:UniqueFuzz LtsPntAll 1e-6)))
(setq LtsIDPnt
(mapcar '(lambda (x) (list (vl-position x LtsPnt) x))
LtsPnt
)
)
(setq LtsID
(mapcar '(lambda (x) (vl-position x LtsPnt))
LtsPnt
)
)
(setq IDStart
(caar (vl-remove-if-not
(function
(lambda (x) (equal PntStart (cadr x) 1e-6))
)
LtsIDPnt
)
)
)
(setq IDEnd
(caar
(vl-remove-if-not
(function (lambda (x) (equal PntEnd (cadr x) 1e-6)))
LtsIDPnt
)
)
)
(setq LtsID_Edge (list))
(foreach e LtsLine
(setq P1 (cdr (assoc 10 (entget e))))
(setq P2 (cdr (assoc 11 (entget e))))
(setq
ID1
(caar (vl-remove-if-not
(function (lambda (x) (equal P1 (cadr x) 1e-6)))
LtsIDPnt
)
)
)
(setq
ID2
(caar (vl-remove-if-not
(function (lambda (x) (equal P2 (cadr x) 1e-6)))
LtsIDPnt
)
)
)
(setq LtsID_Edge
(append
LtsID_Edge
(list
(list ID1
ID2
(distance (nth ID1 LtsPnt)
(nth ID2 LtsPnt)
)
)
)
)
)
)
(setq LtsIDFil (RemoveIDDup LtsID_Edge))
(setq LtsPath (minpath1 IDStart IDEnd LtsID LtsIDFil))
(setq listpoint
(mapcar '(lambda (x) (nth (car x) LtsPnt)) LtsPath)
)
(make3dpl listpoint)
)
(Alert "Qu\U+00E9t ch\U+1ECDn ch\U+01B0a c\U+00F3 LINE ")
)
(setvar 'osmode Olmode)
(princ)
)
(defun SortAB (lstPnt /)
(setq
Lts-Sort (vl-sort
(vl-sort lstPnt
'(lambda (e1 e2) (< (cadr e1) (cadr e2)))
)
'(lambda (e1 e2) (< (car e1) (car e2)))
)
)
Lts-Sort
)
(defun LM:UniqueFuzz (l f)
(if l
(cons (car l)
(LM:UniqueFuzz
(vl-remove-if
(function (lambda (x) (equal x (car l) f)))
(cdr l)
)
f
)
)
)
)
;;; (setq L1 (RemoveIDDup (list '(2 4) '(3 4) '(4 2) '(5 2) '(4 3) )))
(defun RemoveIDDup (l)
(if l
(cons (car l)
(RemoveIDDup
(vl-remove-if
(function (lambda (x)
(or (and (= (car x) (car (car l)))
(= (cadr x) (cadr (car l)))
)
(and (= (car x) (cadr (car l)))
(= (cadr x) (car (car l)))
)
)
)
)
(cdr l)
)
)
)
)
)
(defun LM:ss->ent (ss / i l)
(if ss
(repeat (setq i (sslength ss))
(setq l (cons (ssname ss (setq i (1- i))) l))
)
)
)
(defun make3dpl (ptlst)
(entmake
(list
'(0 . "POLYLINE")
'(100 . "AcDbEntity")
'(100
.
"AcDb3dPolyline"
)
'(66 . 1)
'(62 . 3)
'(10 0.0 0.0 0.0)
'(70 . 8)
'(210 0.0 0.0 1.0)
)
)
(foreach pt ptlst
(entmake
(list
'(0 . "VERTEX")
'(100 . "AcDbEntity")
'(100 . "AcDbVertex")
'(100 . "AcDb3dPolylineVertex")
(cons 10 pt)
'(70 . 32)
)
)
)
(entmake
(list
'(0 . "SEQEND")
'(100 . "AcDbEntity")
)
)
)
(defun minpath1 (g f nodes edges / BRNAME CLNODES CLOSEDL NEW NODNAME
OLD OLDPOS OPENL TOTDIST
)
(setq nodes (vl-remove g nodes))
(setq openl (list (list g 0 nil)))
(setq closedl nil)
(foreach n nodes
(setq nodes (subst (list n 0 nil) n nodes))
)
(while (not (= (caar closedl) f))
(setq nodname (caar openl))
(setq totdist (cadar openl))
(setq closedl (cons (car openl) closedl))
(setq openl (cdr openl))
(setq clnodes (mapcar 'car closedl))
(foreach e edges
(progn
(setq brname nil)
(if (= (car e) nodname)
(setq brname (cadr e))
)
(if (= (cadr e) nodname)
(setq brname (car e))
)
)
(if brname
(progn
(setq new (list brname (+ (caddr e) totdist) nodname))
(cond
((member brname clnodes))
((setq oldpos (vl-position brname (mapcar 'car openl)))
(setq old (nth oldpos openl))
(if (< (cadr new) (cadr old))
(setq openl (subst new old openl))
)
)
(t (setq openl (cons new openl)))
)
(setq edges (vl-remove e edges))
)
)
)
(setq
openl (vl-sort openl
(function (lambda (a b) (< (cadr a) (cadr b))))
)
)
)
(setq minpath (list (car closedl)))
(foreach n closedl
(if (= (car n) (caddr (car minpath)))
(setq minpath (cons n minpath))
)
)
minpath
)
[Code]