[求助]能不能不让命令行一行一行地往上跳
;;;从网上下载程序改装如下，能不能不让命令行一行一行地往上跳 (vl-load-com);;;喷头位置移到吊顶格栅中间(defun c:pt (/ err)(defun algion (msg / ss lst i vlalst boxlst x cor1 cor2 findboxpt newboxpt en1 en enlsty y2 lsta) (princ msg) (setvar "cmdecho" 0) (setvar "OSMODE" 0) (setq ss (ssget '((0 . "CIRCLE") (8 . "cxb_喷头")))) (setq i 0) (repeat (sslength ss) (setq lst (cons (ssname ss i) lst)) (setq i (1+ i)) ) (setq vlalst (mapcar 'vlax-ename->vla-object lst)) (setq boxlst (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) lst ) ) (mapcar '(lambda (x / dxf) (setq dxf (entget x)) (if (assoc 60 dxf) (entmod (subst '(60 . 1) (assoc 60 dxf) dxf));用entdel好象会出问题 (entmod (append dxf '((60 . 1)))) ) ) lst ) (setq newboxpt (mapcar '(lambda (x) (setq en1 (entlast)) (vla-zoomcenter(vlax-get-acad-object)(vlax-3d-point x)5000 );否则boundary速度很慢 (vl-cmdf "_.boundary" x "") (setq en (entlast)) (vla-ZoomPrevious (vlax-get-acad-object)) (if (not (equal en1 en))(progn(setq enlst (entget en))(setq lsta (vl-remove-if-not '(lambda (y) (= (car y) 10)) enlst ))(setq cor1 (vl-remove 10 (car lsta))cor2 (vl-remove 10 (nth 2 lsta)))(entdel en)(polar cor1 (angle cor1 cor2) (/ (DISTANCE cor1 cor2) 2.0))) ) ) boxlst ) ) (mapcar '(lambda (x / dxf) (setq dxf (entget x)) (entmod (subst '(60 . 0) (assoc 60 dxf) dxf));用entdel还原不了? ) lst ) (mapcar '(lambda (x y y2) (vla-move x (vlax-3d-point y) (vlax-3d-point y2)) ) vlalst findboxpt newboxpt ))(setq err (VL-CATCH-ALL-APPLY 'algion (list "\n选择喷头: ")));;;(vla-ZoomExtents (vlax-get-acad-object))(setvar "cmdecho" 1)(setvar "OSMODE" 4151)(princ))
页:
[1]