- 博客(0)
- 资源 (3)
- 问答 (1)
- 收藏
- 关注
MFC类库详解.chm
该MFC参考含盖了Microsoft基本类库中的类、全局函数、全局变量和宏的内容。
参考中“类层次结构图”是为了方便查找某个类的基类。
该MFC参考通常不描述通过继承的函数或操作符。若要寻求这些函数的信息,请参阅类层次结构图中该类的基类信息。
每个类的说明文档包括:该类的概括、类成员的种类、以及该成员函数、重载操作符或数据成员的基本用途。
2009-11-04
将wkai的最短路径由经典改为A星算法
;;时间计算
(defun z_timer (/ stime h m s)
(if (not zhf_time_dot)
(setq zhf_time_dot
(getvar "date")
h nil
)
(progn
(setq stime (getvar "date"))
(setq stime (- stime zhf_time_dot))
(setq stime (* 86400.0 (- stime (fix stime))))
(setq h (fix (/ stime 3600)))
(setq m (fix (/ (- stime (* h 3600)) 60)))
(setq s (- stime (* m 60) (* h 3600)))
(setq zhf_time_dot nil)
(strcat (if (> h 0)
(strcat (rtos h 2 0) "小时")
""
)
(if (> m 0)
(strcat (rtos m 2 0) "分钟")
""
)
(rtos s 2 2)
"秒"
)
)
)
)
;;路径颜色标示
(defun show (lst stop)
(mapcar '(lambda (x) (redraw (vlax-vla-object->ename x) 3))
lst
)
(if stop
(progn (getpoint)
(mapcar '(lambda (x) (redraw (vlax-vla-object->ename x) 4))
lst
)
)
)
)
;;vla是真的情况下,将选择集转换成vla-object实体表
;;vla是假的情况下,将选择集转换成lisp实体表
(defun ss2lst (ss vla / re e)
(if ss
(repeat (setq n (sslength ss))
(if vla
(setq e (vlax-ename->vla-object (ssname ss (setq n (1- n)))))
(setq e (ssname ss (setq n (1- n))))
)
(setq re (append re (list e)))
)
)
re
)
;;获得点所在位置的线(line,pline,spline)、圆弧、椭圆弧
(defun getss@ (p)
(ssget "c"
p
(polar p (/ pi 4) (/ (getvar "viewsize") 5000))
'((0 . "arc,ellipse,*line"))
)
)
;;获得线段另一端连接实体表
(defun getconnect (e)
(vl-remove e
(append (ss2lst (getss@ (vlax-curve-getStartpoint e)) t)
(ss2lst (getss@ (vlax-curve-getEndpoint e)) t)
)
)
)
;;除去表中的重复项,本例程未用到此函数
(defun remove:same (lst / re)
(foreach n lst
(if (member n re)
()
(setq re (append re (list re)))
)
)
re
)
;;获得实体的长度
(defun get:len (e)
(vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
)
;;获得实体的另一个端点到终点的距离
(defun dist-other (ent pt / pta ptb pta2 ptb2)
(setq pta (vlax-curve-getStartpoint ent))
(setq pta2 (list (fix (* 10 (car pta)))(fix (* 10 (cadr pta)))))
(setq ptb (vlax-curve-getEndpoint ent))
(if (member pta2 pt-list)
(distance ptb pt)
(distance pta pt)
)
)
;;获得实体的另一个端点
(defun getotherpt (ent / pta ptb pta2 ptb2)
(setq pta (vlax-curve-getStartpoint ent))
(setq pta2 (list (fix (* 10 (car pta)))(fix (* 10 (cadr pta)))))
(setq ptb (vlax-curve-getEndpoint ent))
(if (member pta2 pt-list)
(setq pt-other ptb)
(setq pt-other pta)
)
)
;;;________________________________________________
;;;________________________________________________
;;;________________________________________________
;;;________________________________________________
;;;A星算法
(defun main (pt1 pt2 show / ss sse line path paths shortlen shortlst ss1
shortest)
(setq count 0)
(setq ss (ss2lst (getss@ pt1) t)
sse (ss2lst (getss@ pt2) t)
)
(if (and ss sse)
(progn
(setq passed-ss ss ;;起点处的实体表,作为延伸后获得的实体表中要去除的实体
pt-list (list (list (fix (* 10 (car pt1)))(fix (* 10 (cadr pt1)))))
path-ss (mapcar '(lambda (x) (list x)) ss) ;;;路径表
dist-ss (mapcar '(lambda (x) (list x (get:len x)(dist-other x pt2))) ss) ;;;路径表,带长度
dist-ss (vl-sort dist-ss '(lambda (a b) (< (+ (cadr a)(caddr a)) (+ (cadr b)(caddr b))))) ;;;排序后
complete nil
)
(if complete
(setq complete (vl-sort complete
'(lambda (a b) (< (cadr a) (cadr b)))
)
shortest (cadar complete) ;;shortest最短路径
)
)
(if (and shortest (= shortest (distance pt1 pt2)))
(progn ;;起止点有直接联通,并且是直线连接(mapcar '(lambda (x)
(if (member x sse);;判断起止点之间是否有直接的连接
(setq
complete (append complete (list (list x (get:len x))))
)
)
)
ss
)
(if (and shortest (= shortest (distance pt1 pt2)))
(progn ;;起止点有直接联通,并且是直线连接
(list (cadar complete) (list (caar complete)))
)
(progn ;;起止点有直接联通,但不是直线连接 或 没有直接连通
(while (and dist-ss (> (length sse) (length complete)))
(setq now (car dist-ss)
dist-ss (cdr dist-ss)
)
;;;_____________________________
;;;_____________________________
;;;_____________________________
(if show
(progn
(vlax-put (car now) 'color (+ 21 (* 10 (rem count 20))))
(vla-update (car now))
)
)
;;;_____________________________
;;;_____________________________
;;;_____________________________
(if (member (car now) sse)
(progn
(setq complete (append complete (list now)))
;;;__________________________________________________
;;;到达终点后剔出所有距离已经超出最小路由长度的未完成方向
(setq complete
(vl-sort complete
'(lambda (a b) (< (cadr a) (cadr b)))
)
)
(setq shortest (cadar complete))
(setq dist-ss (mapcar '(lambda (x)
(if (< (cadr x) shortest)
x
nil
)
)
dist-ss
)
)
(setq dist-ss (vl-remove nil dist-ss))
;;;__________________________________________________
;;;__________________________________________________
)
(progn
(setq count (1+ count))
(setq pt-other (getotherpt (car now)))
(setq ss (ss2lst (getss@ pt-other) t))
(setq pt-list (cons (list (fix (* 10 (car pt-other)))(fix (* 10 (cadr pt-other)))) pt-list))
;; (mapcar '(lambda (x) (setq ss (vl-remove x ss)))
;; passed-ss
;; )
;;上句替换为下面一句 passed-ss较长时,不如直接处理ss
(foreach n ss ;;去掉已走过的路径
(if (member n passed-ss)
(setq ss (vl-remove n ss))
)
)
(if ss
(progn
;; (setq passed-ss (append passed-ss ss)
;; path-ss (append
;; path-ss
;; (mapcar '(lambda (x) (list x (car now))) ss)
;; )
;; )
;; (setq dist-ss (append
;; dist-ss
;; (mapcar
;; '(lambda (x)
;; (if (or (not shortest)
;; (< (get:len x) shortest)
;; )
;; (list x (+ (cadr now) (get:len x)))
;; )
;; )
;; ss
;; )
;; )
;; )
;;上两句替换为下面循环结构 mapcar+append->foreach+cons
(foreach n ss
(setq passed-ss (cons n passed-ss)) ;;把新路径增加到已走过的路径
(setq path-ss (cons (list n (car now)) path-ss)) ;;把新路由增加到已有路由表中
(if (or (not shortest) (< (get:len n) shortest))
(setq dist-ss (cons (list n (+ (cadr now) (get:len n))(dist-other n pt2)) dist-ss))
)
)
;; (setq dist-ss (vl-remove nil dist-ss))
(setq dist-ss (vl-sort dist-ss ;;按距离排序
'(lambda (a b) (< (+ (cadr a)(caddr a)) (+ (cadr b)(caddr b))))
)
)
)
)
)
)
)
;;;_____________________________
;;;_____________________________
;;;_____________________________
(if show
(progn
(mapcar '(lambda (x) (vlax-put x 'color 0)) passed-ss)
(mapcar '(lambda (x) (vla-update x)) passed-ss)
)
)
;;;_____________________________
;;;_____________________________
;;;_____________________________
(if complete
(progn
(setq
complete (vl-sort complete
'(lambda (a b) (< (cadr a) (cadr b)))
)
n (car complete)
)
(setq len (cadr n)
n (car n)
)
(while n
(setq ss1 (append ss1 (list n)))
(setq n (cadr (assoc n path-ss)))
)
(list len (reverse ss1))
)
nil
)
)
)
)
nil
)
)
;;;________________________________________________
;;;________________________________________________
;;;________________________________________________
;;;________________________________________________
(defun c:ttz (/ pt1 pt2 ss1 ss2 complete)
(redraw)
(setq pt1 (getpoint "\n起点:")
pt2 (getpoint "\n终点:")
)
(mapcar
'(lambda (pt)
(grdraw (polar pt (* pi 0.25) (/ (getvar "viewsize") 40))
(polar pt (* pi -0.75) (/ (getvar "viewsize") 40))
1
)
(grdraw (polar pt (* pi 0.75) (/ (getvar "viewsize") 40))
(polar pt (* pi -0.25) (/ (getvar "viewsize") 40))
1
)
)
(list pt1 pt2)
)
(setq zhf_time_dot nil)
(z_timer)
(setq ss1 (main pt1 pt2 t))
(if ss1
(progn
(setq ss2 (ssadd))
(mapcar '(lambda (x)
(setq ss2 (ssadd (vlax-vla-object->ename x) ss2))
)
(cadr ss1)
)
(princ (strcat "\n虚线显示最短路线, 共需"
(itoa (sslength ss2))
"步,总长度为:"
(rtos (car ss1))
" 历时:"
(z_timer)
)
)
(show (cadr ss1) nil)
)
(princ (strcat "\n两点间没有可连通路径,历时:" (z_timer)))
)
(princ)
)
;;;________________________________________________
;;;________________________________________________
;;;________________________________________________
;;;________________________________________________
(princ "\n寻找连接两点的最近路线,by wkai @ xdcad ")
(princ
"\n前提 所有路线只在交点处交叉,起点和终点选择路线的端点."
)
(princ "\n核心函数 (main 起点 终点 是否显示搜索过程) ")
(princ "\n返回值 (最短路线长度 最短路线途径实体表)")
(princ "\n测试命令:ttz\n")
(princ)
2009-04-06
TA创建的收藏夹 TA关注的收藏夹
TA关注的人