【应用程序错误: 控制台中断】问题解决了【百度知道认证程序员朱正伟解决了此问题，下面为他的源码，经同意公布，让更多人受益】
先上程序，然后细说，现在公布源码
；下面是以我的要求制作的指北针原码【支持动态显示以及无限复制】按ESC不会出现【应用程序错误;控制台中断】及其它错误提示
；制作人:朱正伟
(defun c:t1 ( / %k1 &ob1 &ob2 &ob3 n pt1 pt2 pt5 ss1 x-grread x-gval)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(if (null vlax-dump-object) (vl-load-com) )
(setq ss1 (s09152) %k1 t ss1 (cons %k1 ss1))
(while
(vl-catch-all-apply 'car (setq ss1 (vl-catch-all-apply 's09153 (list ss1)))) )
(princ)
)
(defun s09153 (ss1 / %k1 n pt1 pt2 x-gval xx-1)
(setq %k1 (car ss1) pt1 (cadr ss1) ss1 (cddr ss1))
(setq x-GVal (vl-catch-all-apply 'grread (list t 8)))
(setq n (vl-catch-all-apply 'car (list x-GVal)))
(if (setq xx-1 (vl-catch-all-error-p n))
(setq %k1 nil n 2)
(progn
(if (member n '(3 5))
(progn
(setq pt2 (Vlax-3d-Point (cadr x-GVal)))
(vla-move (car ss1) pt1 pt2)
(vla-move (cadr ss1) pt1 pt2)
(vla-move (caddr ss1) pt1 pt2)
(setq pt1 pt2)
)
)
(if (= n 3)
(progn
(setq ss1 (s09152) pt1 (car ss1) ss1 (cdr ss1))
)
)
)
)
(if (and (/= n 3) (/= n 5))
(progn
(vla-delete (car ss1))
(vla-delete (cadr ss1))
(vla-delete (caddr ss1))
(setq %k1 nil ss1 nil)
)
)
(if ss1 (progn (setq ss1 (cons pt1 ss1) ss1 (cons %k1 ss1))))
ss1
)
(defun s09151 ()
'((0.5 -13.5) (0.5 -0.5) (4.5 -0.5) (4.5 0.5) (0.5 0.5) (0.5 4.5) (2.4 4.5) (0.0 9.12)
(-2.4 4.5) (-0.5 4.5) (-0.5 0.5) (-4.5 0.5) (-4.5 -0.5) (-0.5 -0.5) (-0.5 -13.5))
)
;;建立宋体
(defun text->仿宋 ( / newt)
(if (null (tblsearch "style" "仿宋"))
(progn
(if (null vlax-dump-object) (vl-load-com) )
(setq newT (vla-add (vla-get-TextStyles (vla-get-activedocument (vlax-get-acad-object))) "仿宋"))
(vla-put-fontfile newT "C:\\WINDOWS\\Fonts\\simfang.TTF")
(vla-put-height newT 0);高度0
(vla-put-width newT 0.6);宽度因子0.6
;(vla-put-obliqueAngle newT (/ (* pi 3) 180));倾斜角度3
)
)
)
(defun s09152 ( / pt1 ss x x-object1 x-object2 x-object3)
(text->仿宋);建立字体
(entmake '((0 . "TEXT") (10 0.0 13.74 0.0) (40 . 4.60981) (1 . "N") (41 . 1.0) (7 . "仿宋") (72 . 4) (11 0.0 13.74 0.0)))
(setq x-object1 (vlax-ename->vla-object (entlast)))
(setq ss (mapcar '(lambda (x) (cons 10 x)) (s09151)))
(entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 15) '(70 . 1)) ss))
(setq x-object2 (entlast))
(command "HATCH" "SOLID" (ssadd x-object2) "")
(setq x-object2 (vlax-ename->vla-object x-object2))
(setq x-object3 (vlax-ename->vla-object (entlast)))
(vla-put-color x-object3 7);变颜色
(setq pt1 (Vlax-3d-Point '(0.0 0.0 0.0)))
(list pt1 x-object1 x-object2 x-object3)
)
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
具体说明
下面这样循环，不管怎样都不会提示错误，程序也不会中断
(while (null (vl-catch-all-error-p (setq gr (vl-catch-all-apply 'grread (list t 8)))))
(princ gr)
)
vl-catch-all-apply配合(grread t 8)来写就不出现错误
vl-catch-all-error-p 与vl-catch-all-apply组合，可以消除【; 错误: 函数已取消】
(grread t 8)不提示控制台错误
页:
1
[2]