[求助]AutoCAD中特定角度及长度捕捉的实现方法

xyz2009xyz · 发表于 2010-8-16 22:17:00

AutoCAD中特定角度及长度捕捉的实现方法,很好的一个程序。

哪位大侠能够修改成在CAD2004中能够使用，万分感谢！

;; OS.LSP源程序
　;;err(),出错处理子程序
　(defun err ( msg)
　 (if (/= msg "Function cancelled")
　 (princ(strcat "\nError:" msg)) ;打印错误内容
　 ) ;for if
　 (setq *error* olderr)
　 (setvar "cmdecho" scmd)
　 (setvar "osmode" cosmode)
　 (setvar "coords" ccoords)
　 (princ "n\n\t --多谢使用角度捕捉2.0版,程序非正常结束--!\n")
　 (princ)
　) ;for defun err
　;; ant(),设定捕捉角度子程序
　(defun ant ( / ang0 ang1 )
　 (setq ang0 (* an0 (/ 180 pi)) )
　 (princ (strcat "\n请输入捕捉角度:<" (rtos ang0) ">_"))
　 (INITGET 4)
　 (setq ang1 (getreal))
　 (if (not (null ang1))
　 (setq an0 (* ang1 (/ pi 180)))
　 )
　 (princ "\n F2/F3/F4/F5/ESC/Return /下一点:")
　) ;for defun ant
　;; leng(),设定捕捉长度距离子程序
　(defun leng ( / leng0 leng1 )
　 (setq leng0 len0)
　 (princ (strcat "\n 请输入捕捉长度距离:<" (rtos leng0) ">_"))
　 (INITGET 4)
　 (setq leng1 (getreal))
　 (if (not (null leng1))
　 (setq len0 leng1 )
　 )
　 (princ "\n F2/F3/F4/F5/ESC/Return /下一点:")
　) ;for defun lent
　;; field(),判断十字光标所在区间,并投影到相应的捕捉角度线上
　(defun field ( ps pe ang0 / ang1 n )
　 (setq ang1 (angle ps pe))
　 (setq n (fix (+ ( / ang1 ang0) 0.5)))
　 (setq ang2 (* ang0 n))
　);for defun
　;; endp(), 十字光标投影到相应的捕捉角度上后,以用户设定的长度
　;; 捕捉计算落点
海立
05.16 16:35
(defun endp ( ps pe ang0 / p1 p2 p3 p4 dis )
　 (setq p1 ps
　 p2 (polar ps ang0 1)
　 p3 pe
　 p4 (polar pe (+ ang0 (/ pi 2)) 1)
　 )
　 (setq pend (inters p1 p2 p3 p4 nil))
　 (setq dis (distance ps pe))
　 (if ( / = len0 0)
　 (setq dist (* (fix (+ (/ dis len0) 0.5)) len0))
　 ;else
　 (setq dist dis)
　 ) ;for if
　 (setq pend (polar ps ang0 dist))
　) ;for defun endp
　;; drag(), 对上一次显示的拖曳线进行"或"操作,使其从屏幕上消失,
　;; 并绘制下一次拖曳线
　(defun drag ( pold1 pold2 pold3 / )
　 (if ( / = b2 4)
　 (progn
　 (grdraw pold1 pold2 -1 0)
　 (grdraw pold2 pold3 -1 0)
　 )
　 ) ;for if
　 (grdraw pstart pend -1 0)
　 (grdraw pend pframe -1 0)
　) ;for defun drag
　;; coord(), 在屏幕的最上一行的坐标栏显示长度和角度
　(defun coord ( / str leng1 leng0 ang0)
　 (setq ang0 (* ang2 (/ 180 pi)) )
　 (setq str (strcat (rtos dist) ">" (rtos ang0)))
　 (grtext -2 str)
　) ;for defun coord
　;; init(), 对程序进行初始化
　(defun init ( / )
　 (setq scmd (getvar "cmdecho"));保留原命令回显方式
　 (setq ccoords (getvar "coords"));保留原坐标显示方式
　 (setq cosmode (getvar "osmode"))
　 (setq olderr *error* *error* err) ;出错处理
(setvar "cmdecho" 0);不回显
　 (setvar "coords" 0) ;不显示坐标
　 (setvar "osmode" 0 ) ;取消捕捉
　 (setq b 0 b1 0 c '(0 0) )
　 (setq pstart (getpoint "\n 请输入直线第一点:"))
　 (if (or (null an0 ) (< an0 0) (not (numberp an0)))
　 (progn
　 (setq an0 (/ pi 6))
　 (ant)
　 )
　 ) ; for if
　 (if (or (null len0 ) (< len0 0) (not (numberp len0)))
　 (progn
　 (setq len0 1)
　 (leng)
　 )
　 ) ;for if
　 (if (null len0) (leng))
　 (princ "\n F2/F3/F4/F5/ESC/Return /下一点::")
　 (setq a (grread 2 nil))
　 (setq pframe (cadr a))
　 (field pstart pframe an0)
　 (endp pstart pframe ang2)
　 (grdraw pstart pend -1 0)
　 (grdraw pend pframe -1 0)
　 (setq plast pframe polde pend)
　 (setq b (car a))
　) ;for defun init
　 ;; home(), 设置退出程序的控制变量
　(defun home ( / )
　 (setq b 3)
　 (setq b1 1)
　) ;for defun home
　;; pull(), 接受用户输入控制子程序
　(defun pull ( / )
　(setq b1 0)
　(while (/= b 3)
　 (progn
　 (setq a (grread 2 nil))
　 (coord)
　 (if (and (= b 2) (= b2 4)) (setq b 4))
　 (setq b2 b)
　 (setq b (car a))
　 (cond
　 ((or (= b 5) (= b 12) );只移动十字光标时
　 (progn
　 (setq pframe (cadr a))
　 (field pstart pframe an0)
　 (endp pstart pframe ang2)
　 (if (>= (distance plast pframe) 0.1)
　 (progn
　 (drag pstart polde plast)
　 (setq plast pframe polde pend)
　 ) ;for progn
　 ) ;for if
　 ) ;for progn
　 ) ;for cond1
　 ( (= b 3);用鼠标在屏幕上点取一点时
(progn
　 (setq pframe (cadr a))
　 (field pstart pframe an0)
　 (endp pstart pframe ang2)
　 (if (>= (distance plast pframe) 0.1)
　 (progn
　 (grdraw pstart polde -1 0)
　 (setq plast pframe polde pend)
　 ) ;for progn
　 ) ;for if
　 ) ;for progn
　 ) ;for cond1
　 ((= b 2);键盘输入
　 (progn
　 (setq c1 (cadr a))
　 (cond ((= c1 138) (ant)) ;F2
　 ((= c1 139) (leng)) ;F3
　 ((= c1 140) ;F4
　 (progn
　 (setq b2 4)
　 (command"zoom" "0.7x")
　 )
　 ) ;for (= c1 140)
　 ((= c1 141) ;F5
　 (progn
　 (setq b2 4)
　 (command"zoom" "1.4x")
　 )
　 ) ;for (= c1 141)
　 ((= c1 13) (home))
　 ((= c1 27) (home))
　 (T (princ "\n 未定义的键"))
　 ) ;for cond
　 (princ "\n F2/F3/F4/F5/ESC/Return /下一点:")
　 );for progn
　 );for (cond (= b 2))
　 ((= b 4);点取下拉菜单时
　 (progn
　 (setq c1 (cadr a))
　 (princ "\n")
　 (cond ((= c1 6005)
　 (progn
　 (command"zoom" "w")
　 (princ "\n 第一角点:")
　 (command pause)
　 (princ "\n 第二角点:")
　 (command pause)
　 )
　 ) ;for (= c1 6005)
　 ((= c1 6007)
　 (command"zoom" "p" ))
　 ((= c1 6008)
　 (command"zoom" "a" ))
　 ((= c1 6011)
　 (progn
　 (command"pan")
　 (princ "\n 第一参考点:")
　 (command pause)
　 (princ "\n 第二参考点:")
　 command pause)
　 )
　 ) ;for (= c1 6011)
　 ;;else
　 (T (princ "\n 未定义的菜单"))
) ;for cond
　 (princ "\n F2/F3/F4/F5/ESC/Return /下一点:")
　 ) ;FOR PROGN
　 ) ;for (cond (= b 4))
　 (T (home) ) ;for else
　 ) ;for cond
　 ) ;for progn
　 ) ;for while
　) ;for defun pull
　;; draw() , 绘制直线子程序
　(defun draw ( / )
　 (while (/= b1 1)
　 (progn
　 (if (= b 3)
　 (progn
　 (command"line" pstart pend "")
　 (princ "\n F2/F3/F4/F5/ESC/Return /下一点:")
　 (setq b 0 b1 1)
　 (setq pstart pend)
　 );for progn
　 ); for if
　 (pull)
　 ) ;for progn
　 ) ;for while
　 (grdraw pstart pend -1 0)
　 (grdraw pend pframe -1 0)
　) ;for defun draw
　;;;;主程序
　(defun c:os ( / b b1 b2 c pstart pend pframe plast ang2
　 dist scmd ccoords olderr cosmode )
　 ;;; an0 len0 are defined out program
　(init)
　(draw)
　(princ "\n")
　(command"redraw")
　(setq *error* olderr)
　(setvar "cmdecho" scmd)
　(setvar "osmode" cosmode)
　(setvar "coords" ccoords)
　(princ "\n\n\t ------角度捕捉2.0版------\n")
　(princ "\n\n\t**宁波大学建筑设计研究院--程建华,1996**\n")
　(princ)
　) ;for defun os

;; OS.LSP源程序  
 　;;err(),出错处理子程序  
 　(defun err ( msg)  
 　 (if (/= msg "Function cancelled")  
 　 (princ(strcat "\nError:" msg)) ;打印错误内容  
 　 ) ;for if  
 　 (setq *error* olderr)  
 　 (setvar "cmdecho" scmd)  
 　 (setvar "osmode" cosmode)  
 　 (setvar "coords" ccoords)  
 　 (princ "n\n\t --多谢使用角度捕捉2.0版,程序非正常结束--!\n")  
 　 (princ)  
 　) ;for defun err  
 　;; ant(),设定捕捉角度子程序  
 　(defun ant ( / ang0 ang1 )  
 　 (setq ang0 (* an0 (/ 180 pi)) )  
 　 (princ (strcat "\n请输入捕捉角度:<" (rtos ang0) ">_"))  
 　 (INITGET 4)  
 　 (setq ang1 (getreal))  
 　 (if (not (null ang1))  
 　 (setq an0 (* ang1 (/ pi 180)))  
 　 )  
 　 (princ "\n F2/F3/F4/F5/ESC/Return /下一点:")  
 　) ;for defun ant  
 　;; leng(),设定捕捉长度距离子程序  
 　(defun leng ( / leng0 leng1 )  
 　 (setq leng0 len0)  
 　 (princ (strcat "\n 请输入捕捉长度距离:<" (rtos leng0) ">_"))  
 　 (INITGET 4)  
 　 (setq leng1 (getreal))  
 　 (if (not (null leng1))  
 　 (setq len0 leng1 )  
 　 )  
 　 (princ "\n F2/F3/F4/F5/ESC/Return /下一点:")  
 　) ;for defun lent  
 　;; field(),判断十字光标所在区间,并投影到相应的捕捉角度线上  
 　(defun field ( ps pe ang0 / ang1 n )  
 　 (setq ang1 (angle ps pe))  
 　 (setq n (fix (+ ( / ang1 ang0) 0.5)))  
 　 (setq ang2 (* ang0 n))  
 　);for defun  
 　;; endp(), 十字光标投影到相应的捕捉角度上后,以用户设定的长度  
 　;; 捕捉计算落点  
  
 海立  
 05.16 16:35  
  
(defun endp ( ps pe ang0 / p1 p2 p3 p4 dis )  
 　 (setq p1 ps  
 　 p2 (polar ps ang0 1)  
 　 p3 pe  
 　 p4 (polar pe (+ ang0 (/ pi 2)) 1)  
 　 )  
 　 (setq pend (inters p1 p2 p3 p4 nil))  
 　 (setq dis (distance ps pe))  
 　 (if ( / = len0 0)  
 　 (setq dist (* (fix (+ (/ dis len0) 0.5)) len0))  
 　 ;else  
 　 (setq dist dis)  
 　 ) ;for if  
 　 (setq pend (polar ps ang0 dist))  
 　) ;for defun endp  
 　;; drag(), 对上一次显示的拖曳线进行"或"操作,使其从屏幕上消失,  
 　;; 并绘制下一次拖曳线  
 　(defun drag ( pold1 pold2 pold3 / )  
 　 (if ( / = b2 4)  
 　 (progn  
 　 (grdraw pold1 pold2 -1 0)  
 　 (grdraw pold2 pold3 -1 0)  
 　 )  
 　 ) ;for if  
 　 (grdraw pstart pend -1 0)  
 　 (grdraw pend pframe -1 0)  
 　) ;for defun drag  
 　;; coord(), 在屏幕的最上一行的坐标栏显示长度和角度  
 　(defun coord ( / str leng1 leng0 ang0)  
 　 (setq ang0 (* ang2 (/ 180 pi)) )  
 　 (setq str (strcat (rtos dist) ">" (rtos ang0)))  
 　 (grtext -2 str)  
 　) ;for defun coord  
 　;; init(), 对程序进行初始化  
 　(defun init ( / )  
 　 (setq scmd (getvar "cmdecho"));保留原命令回显方式  
 　 (setq ccoords (getvar "coords"));保留原坐标显示方式  
 　 (setq cosmode (getvar "osmode"))  
 　 (setq olderr *error* *error* err) ;出错处理
(setvar "cmdecho" 0);不回显  
 　 (setvar "coords" 0) ;不显示坐标  
 　 (setvar "osmode" 0 ) ;取消捕捉  
 　 (setq b 0 b1 0 c '(0 0) )  
 　 (setq pstart (getpoint "\n 请输入直线第一点:"))  
 　 (if (or (null an0 ) (< an0 0) (not (numberp an0)))  
 　 (progn  
 　 (setq an0 (/ pi 6))  
 　 (ant)  
 　 )  
 　 ) ; for if  
 　 (if (or (null len0 ) (< len0 0) (not (numberp len0)))  
 　 (progn  
 　 (setq len0 1)  
 　 (leng)  
 　 )  
 　 ) ;for if  
 　 (if (null len0) (leng))  
 　 (princ "\n F2/F3/F4/F5/ESC/Return /下一点::")  
 　 (setq a (grread 2 nil))  
 　 (setq pframe (cadr a))  
 　 (field pstart pframe an0)  
 　 (endp pstart pframe ang2)  
 　 (grdraw pstart pend -1 0)  
 　 (grdraw pend pframe -1 0)  
 　 (setq plast pframe polde pend)  
 　 (setq b (car a))  
 　) ;for defun init  
 　 ;; home(), 设置退出程序的控制变量  
 　(defun home ( / )  
 　 (setq b 3)  
 　 (setq b1 1)  
 　) ;for defun home  
 　;; pull(), 接受用户输入控制子程序  
 　(defun pull ( / )  
 　(setq b1 0)  
 　(while (/= b 3)  
 　 (progn  
 　 (setq a (grread 2 nil))  
 　 (coord)  
 　 (if (and (= b 2) (= b2 4)) (setq b 4))  
 　 (setq b2 b)  
 　 (setq b (car a))  
 　 (cond  
 　 ((or (= b 5) (= b 12) );只移动十字光标时  
 　 (progn  
 　 (setq pframe (cadr a))  
 　 (field pstart pframe an0)  
 　 (endp pstart pframe ang2)  
 　 (if (>= (distance plast pframe) 0.1)  
 　 (progn  
 　 (drag pstart polde plast)  
 　 (setq plast pframe polde pend)  
 　 ) ;for progn  
 　 ) ;for if  
 　 ) ;for progn  
 　 ) ;for cond1  
 　 ( (= b 3);用鼠标在屏幕上点取一点时
(progn  
 　 (setq pframe (cadr a))  
 　 (field pstart pframe an0)  
 　 (endp pstart pframe ang2)  
 　 (if (>= (distance plast pframe) 0.1)  
 　 (progn  
 　 (grdraw pstart polde -1 0)  
 　 (setq plast pframe polde pend)  
 　 ) ;for progn  
 　 ) ;for if  
 　 ) ;for progn  
 　 ) ;for cond1  
 　 ((= b 2);键盘输入  
 　 (progn  
 　 (setq c1 (cadr a))  
 　 (cond ((= c1 138) (ant)) ;F2  
 　 ((= c1 139) (leng)) ;F3  
 　 ((= c1 140) ;F4  
 　 (progn  
 　 (setq b2 4)  
 　 (command"zoom" "0.7x")  
 　 )  
 　 ) ;for (= c1 140)  
 　 ((= c1 141) ;F5  
 　 (progn  
 　 (setq b2 4)  
 　 (command"zoom" "1.4x")  
 　 )  
 　 ) ;for (= c1 141)  
 　 ((= c1 13) (home))  
 　 ((= c1 27) (home))  
 　 (T (princ "\n 未定义的键"))  
 　 ) ;for cond  
 　 (princ "\n F2/F3/F4/F5/ESC/Return /下一点:")  
 　 );for progn  
 　 );for (cond (= b 2))  
 　 ((= b 4);点取下拉菜单时  
 　 (progn  
 　 (setq c1 (cadr a))  
 　 (princ "\n")  
 　 (cond ((= c1 6005)  
 　 (progn  
 　 (command"zoom" "w")  
 　 (princ "\n 第一角点:")  
 　 (command pause)  
 　 (princ "\n 第二角点:")  
 　 (command pause)  
 　 )  
 　 ) ;for (= c1 6005)  
 　 ((= c1 6007)  
 　 (command"zoom" "p" ))  
 　 ((= c1 6008)  
 　 (command"zoom" "a" ))  
 　 ((= c1 6011)  
 　 (progn  
 　 (command"pan")  
 　 (princ "\n 第一参考点:")  
 　 (command pause)  
 　 (princ "\n 第二参考点:")  
 　 command pause)  
 　 )  
 　 ) ;for (= c1 6011)  
 　 ;;else  
 　 (T (princ "\n 未定义的菜单"))
) ;for cond  
 　 (princ "\n F2/F3/F4/F5/ESC/Return /下一点:")  
 　 ) ;FOR PROGN  
 　 ) ;for (cond (= b 4))  
 　 (T (home) ) ;for else  
 　 ) ;for cond  
 　 ) ;for progn  
 　 ) ;for while  
 　) ;for defun pull  
 　;; draw() , 绘制直线子程序  
 　(defun draw ( / )  
 　 (while (/= b1 1)  
 　 (progn  
 　 (if (= b 3)  
 　 (progn  
 　 (command"line" pstart pend "")  
 　 (princ "\n F2/F3/F4/F5/ESC/Return /下一点:")  
 　 (setq b 0 b1 1)  
 　 (setq pstart pend)  
 　 );for progn  
 　 ); for if  
 　 (pull)  
 　 ) ;for progn  
 　 ) ;for while  
 　 (grdraw pstart pend -1 0)  
 　 (grdraw pend pframe -1 0)  
 　) ;for defun draw  
 　;;;;主程序  
 　(defun c:os ( / b b1 b2 c pstart pend pframe plast ang2  
 　 dist scmd ccoords olderr cosmode )  
 　 ;;; an0 len0 are defined out program  
 　(init)  
 　(draw)  
 　(princ "\n")  
 　(command"redraw")  
 　(setq *error* olderr)  
 　(setvar "cmdecho" scmd)  
 　(setvar "osmode" cosmode)  
 　(setvar "coords" ccoords)  
 　(princ "\n\n\t ------角度捕捉2.0版------\n")  
 　(princ "\n\n\t**宁波大学建筑设计研究院--程建华,1996**\n")  
 　(princ)  
 　) ;for defun os

xyz2009xyz · 发表于 2010-8-17 19:45:00

请各位帮帮忙！

ZZXXQQ · 发表于 2010-8-17 20:58:00

本帖最后由作者于 2010-8-18 20:12:26 编辑

;; OS.LSP源程序
;;err(),出错处理子程序
(defun err (msg)
(if (/= msg "Function cancelled")
(princ(strcat "\nError:" msg)) ;打印错误内容
) ;for if
(setq *error* olderr)
(setvar "cmdecho" scmd)
(setvar "osmode" cosmode)
(setvar "coords" ccoords)
(princ "n\n\t --多谢使用角度捕捉2.0版,程序非正常结束--!\n")
(princ)
) ;for defun err
;; ant(),设定捕捉角度子程序
(defun ant (/ ang0 ang1)
(setq ang0 (* an0 (/ 180 pi)))
(INITGET 4)
(setq ang1 (getreal (strcat "\n请输入捕捉角度:<" (rtos ang0) ">_")))
(if ang1 (setq an0 (* ang1 (/ pi 180))))
(princ "\n F2/F3/F4/F5/ESC/Return /下一点:")
) ;for defun ant
;; leng(),设定捕捉长度距离子程序
(defun leng (/ leng1)
(INITGET 4)
(setq leng1 (getreal (strcat "\n 请输入捕捉长度距离:<" (rtos len0) ">_")))
(if leng1 (setq len0 leng1))
(princ "\n F2/F3/F4/F5/ESC/Return /下一点:")
) ;for defun lent
;; field(),判断十字光标所在区间,并投影到相应的捕捉角度线上
(defun field (ps pe ang0 / ang1 n)
(setq ang1 (angle ps pe))
(setq n (fix (+ (/ ang1 ang0) 0.5)))
(setq ang2 (* ang0 n))
);for defun
;; endp(), 十字光标投影到相应的捕捉角度上后,以用户设定的长度
;; 捕捉计算落点
; 海立 05.16 16:35
(defun endp (ps pe ang0 / p1 p2 p3 p4 dis)
(setq p1 ps
p2 (polar ps ang0 1)
p3 pe
p4 (polar pe (+ ang0 (/ pi 2)) 1)
)
(setq pend (inters p1 p2 p3 p4 nil))
(setq dis (distance ps pe))
(if (/= len0 0)
(setq dist (* (fix (+ (/ dis len0) 0.5)) len0))
　 ;else
(setq dist dis)
) ;for if
(setq pend (polar ps ang0 dist))
) ;for defun endp
;; drag(), 对上一次显示的拖曳线进行"或"操作,使其从屏幕上消失,
;; 并绘制下一次拖曳线
(defun drag (pold1 pold2 pold3)
(if (/= b2 4) (progn
(grdraw pold1 pold2 -1 0)
(grdraw pold2 pold3 -1 0)
)) ;for if
(grdraw pstart pend -1 0)
(grdraw pend pframe -1 0)
) ;for defun drag
;; coord(), 在屏幕的最上一行的坐标栏显示长度和角度
(defun coord (/ str leng1 leng0 ang0)
(setq ang0 (* ang2 (/ 180 pi)))
(setq str (strcat (rtos dist) ">" (rtos ang0)))
(grtext -2 str)
) ;for defun coord
;; init(), 对程序进行初始化
(defun init ()
(setq scmd (getvar "cmdecho"));保留原命令回显方式
(setq ccoords (getvar "coords"));保留原坐标显示方式
(setq cosmode (getvar "osmode"))
(setq olderr *error* *error* err) ;出错处理
(setvar "cmdecho" 0);不回显
(setvar "coords" 0) ;不显示坐标
(setvar "osmode" 0 ) ;取消捕捉
(setq b 0 b1 0 c '(0 0))
(setq pstart (getpoint "\n 请输入直线第一点:"))
(if (or (null an0 ) (< an0 0) (not (numberp an0))) (progn
(setq an0 (/ pi 6))
(ant)
)) ; for if
(if (or (null len0 ) (< len0 0) (not (numberp len0))) (progn
(setq len0 1)
(leng)
)) ;for if
(if (null len0) (leng))
(princ "\n F2/F3/F4/F5/ESC/Return /下一点::")
(setq a (grread nil 2))
(setq pframe (cadr a))
(field pstart pframe an0)
(endp pstart pframe ang2)
(grdraw pstart pend -1 0)
(grdraw pend pframe -1 0)
(setq plast pframe polde pend)
(setq b (car a))
) ;for defun init
;; home(), 设置退出程序的控制变量
(defun home ()
(setq b 3)
(setq b1 1)
) ;for defun home
;; pull(), 接受用户输入控制子程序
(defun pull ()
(setq b1 0)
(while (/= b 3)
(setq a (grread nel 2))
(coord)
(if (and (= b 2) (= b2 4)) (setq b 4))
(setq b2 b)
(setq b (car a))
(cond
((or (= b 5) (= b 12) );只移动十字光标时
(setq pframe (cadr a))
(field pstart pframe an0)
(endp pstart pframe ang2)
(if (>= (distance plast pframe) 0.1) (progn
(drag pstart polde plast)
(setq plast pframe polde pend)
)) ;for if
) ;for cond1
((= b 3);用鼠标在屏幕上点取一点时
(setq pframe (cadr a))
(field pstart pframe an0)
(endp pstart pframe ang2)
(if (>= (distance plast pframe) 0.1) (progn
(grdraw pstart polde -1 0)
(setq plast pframe polde pend)
)) ;for if
) ;for cond1
((= b 2);键盘输入
(setq c1 (cadr a))
(cond ((= c1 138) (ant)) ;F2
((= c1 139) (leng)) ;F3
((= c1 140) ;F4
(setq b2 4)
(command"zoom" "0.7x")
) ;for (= c1 140)
((= c1 141) ;F5
(setq b2 4)
(command"zoom" "1.4x")
　 ) ;for (= c1 141)
((= c1 13) (home))
((= c1 27) (home))
(T (princ "\n 未定义的键"))
) ;for cond
(princ "\n F2/F3/F4/F5/ESC/Return /下一点:")
);for (cond (= b 2))
((= b 4);点取下拉菜单时
(setq c1 (cadr a))
(princ "\n")
(cond
((= c1 6005)
(command"zoom" "w")
(princ "\n 第一角点:")
(command pause)
(princ "\n 第二角点:")
(command pause)
) ;for (= c1 6005)
((= c1 6007) (command "zoom" "p" ))
((= c1 6008) (command "zoom" "a" ))
((= c1 6011)
(command"pan")
(princ "\n 第一参考点:")
(command pause)
(princ "\n 第二参考点:")
(command pause)
) ;for (= c1 6011)
　 ;;else
(T (princ "\n 未定义的菜单"))
) ;for cond
(princ "\n F2/F3/F4/F5/ESC/Return /下一点:")
) ;for (cond (= b 4))
(T (home)) ;for else
) ;for cond
) ;for while
) ;for defun pull
;; draw() , 绘制直线子程序
(defun draw ()
(while (/= b1 1)
(if (= b 3) (progn
(command"line" pstart pend "")
(princ "\n F2/F3/F4/F5/ESC/Return /下一点:")
(setq b 0 b1 1)
(setq pstart pend)
)); for if
(pull)
) ;for while
(grdraw pstart pend -1 0)
(grdraw pend pframe -1 0)
) ;for defun draw
;;;;主程序
(defun c:os (/ b b1 b2 c pstart pend pframe plast ang2
　 dist scmd ccoords olderr cosmode)
;;; an0 len0 are defined out program
(init)
(draw)
(princ "\n")
(redraw)
(setq *error* olderr)
(setvar "cmdecho" scmd)
(setvar "osmode" cosmode)
(setvar "coords" ccoords)
(princ "\n\n\t ------角度捕捉2.0版------\n")
(princ "\n\n\t**宁波大学建筑设计研究院--程建华,1996**\n")
(princ)
) ;for defun os

;; OS.LSP源程序
;;err(),出错处理子程序
(defun err (msg)
 (if (/= msg "Function cancelled")
  (princ(strcat "\nError:" msg)) ;打印错误内容
 ) ;for if
 (setq *error* olderr)
 (setvar "cmdecho" scmd)
 (setvar "osmode" cosmode)
 (setvar "coords" ccoords)
 (princ "n\n\t --多谢使用角度捕捉2.0版,程序非正常结束--!\n")
 (princ)
) ;for defun err
;; ant(),设定捕捉角度子程序
(defun ant (/ ang0 ang1)
 (setq ang0 (* an0 (/ 180 pi)))
 (INITGET 4)
 (setq ang1 (getreal (strcat "\n请输入捕捉角度:<" (rtos ang0) ">_")))
 (if ang1 (setq an0 (* ang1 (/ pi 180))))
 (princ "\n F2/F3/F4/F5/ESC/Return /下一点:")
) ;for defun ant
;; leng(),设定捕捉长度距离子程序
(defun leng (/ leng1)
 (INITGET 4)
 (setq leng1 (getreal  (strcat "\n 请输入捕捉长度距离:<" (rtos len0) ">_")))
 (if leng1 (setq len0 leng1))
 (princ "\n F2/F3/F4/F5/ESC/Return /下一点:")
) ;for defun lent
;; field(),判断十字光标所在区间,并投影到相应的捕捉角度线上
(defun field (ps pe ang0 / ang1 n)
 (setq ang1 (angle ps pe))
 (setq n (fix (+ (/ ang1 ang0) 0.5)))
 (setq ang2 (* ang0 n))
);for defun
;; endp(), 十字光标投影到相应的捕捉角度上后,以用户设定的长度
;; 捕捉计算落点
; 海立   05.16 16:35
(defun endp (ps pe ang0 / p1 p2 p3 p4 dis)
 (setq p1 ps
       p2 (polar ps ang0 1)
       p3 pe
       p4 (polar pe (+ ang0 (/ pi 2)) 1)
 )
 (setq pend (inters p1 p2 p3 p4 nil))
 (setq dis (distance ps pe))
 (if (/= len0 0)
  (setq dist (* (fix (+ (/ dis len0) 0.5)) len0))
 　 ;else
  (setq dist dis)
 ) ;for if
 (setq pend (polar ps ang0 dist))
) ;for defun endp
;; drag(), 对上一次显示的拖曳线进行"或"操作,使其从屏幕上消失,
;; 并绘制下一次拖曳线
(defun drag (pold1 pold2 pold3)
 (if (/= b2 4) (progn
  (grdraw pold1 pold2 -1 0)
  (grdraw pold2 pold3 -1 0)
 )) ;for if
 (grdraw pstart pend -1 0)
 (grdraw pend pframe -1 0)
) ;for defun drag
;; coord(), 在屏幕的最上一行的坐标栏显示长度和角度
(defun coord (/ str leng1 leng0 ang0)
 (setq ang0 (* ang2 (/ 180 pi)))
 (setq str (strcat (rtos dist) ">" (rtos ang0)))
 (grtext -2 str)
) ;for defun coord
;; init(), 对程序进行初始化
(defun init ()
 (setq scmd (getvar "cmdecho"));保留原命令回显方式
 (setq ccoords (getvar "coords"));保留原坐标显示方式
 (setq cosmode (getvar "osmode"))
 (setq olderr *error* *error* err) ;出错处理
 (setvar "cmdecho" 0);不回显
 (setvar "coords" 0) ;不显示坐标
 (setvar "osmode" 0 ) ;取消捕捉
 (setq b 0 b1 0 c '(0 0))
 (setq pstart (getpoint "\n 请输入直线第一点:"))
 (if (or (null an0 ) (< an0 0) (not (numberp an0))) (progn
  (setq an0 (/ pi 6))
  (ant)
 )) ; for if
 (if (or (null len0 ) (< len0 0) (not (numberp len0))) (progn
  (setq len0 1)
  (leng)
 )) ;for if
 (if (null len0) (leng))
  (princ "\n F2/F3/F4/F5/ESC/Return /下一点::")
  (setq a (grread nil 2))
  (setq pframe (cadr a))
  (field pstart pframe an0)
  (endp pstart pframe ang2)
  (grdraw pstart pend -1 0)
  (grdraw pend pframe -1 0)
  (setq plast pframe polde pend)
  (setq b (car a))
 ) ;for defun init
;; home(), 设置退出程序的控制变量
(defun home ()
 (setq b 3)
 (setq b1 1)
) ;for defun home
;; pull(), 接受用户输入控制子程序
(defun pull ()
 (setq b1 0)
 (while (/= b 3)
  (setq a (grread nel 2))
  (coord)
  (if (and (= b 2) (= b2 4)) (setq b 4))
  (setq b2 b)
  (setq b (car a))
  (cond
   ((or (= b 5) (= b 12) );只移动十字光标时
    (setq pframe (cadr a))
    (field pstart pframe an0)
    (endp pstart pframe ang2)
    (if (>= (distance plast pframe) 0.1) (progn
     (drag pstart polde plast)
     (setq plast pframe polde pend)
    )) ;for if
   ) ;for cond1
   ((= b 3);用鼠标在屏幕上点取一点时
    (setq pframe (cadr a))
    (field pstart pframe an0)
    (endp pstart pframe ang2)
    (if (>= (distance plast pframe) 0.1) (progn
     (grdraw pstart polde -1 0)
     (setq plast pframe polde pend)
    )) ;for if
   ) ;for cond1
   ((= b 2);键盘输入
    (setq c1 (cadr a))
    (cond ((= c1 138) (ant)) ;F2
    ((= c1 139) (leng)) ;F3
    ((= c1 140) ;F4
     (setq b2 4)
     (command"zoom" "0.7x")
    ) ;for (= c1 140)
    ((= c1 141) ;F5
     (setq b2 4)
     (command"zoom" "1.4x")
 　 ) ;for (= c1 141)
    ((= c1 13) (home))
    ((= c1 27) (home))
    (T (princ "\n 未定义的键"))
   ) ;for cond
   (princ "\n F2/F3/F4/F5/ESC/Return /下一点:")
  );for (cond (= b 2))
  ((= b 4);点取下拉菜单时
   (setq c1 (cadr a))
   (princ "\n")
   (cond
    ((= c1 6005)
     (command"zoom" "w")
     (princ "\n 第一角点:")
     (command pause)
     (princ "\n 第二角点:")
     (command pause)
    ) ;for (= c1 6005)
    ((= c1 6007) (command "zoom" "p" ))
    ((= c1 6008) (command "zoom" "a" ))
    ((= c1 6011)
     (command"pan")
     (princ "\n 第一参考点:")
     (command pause)
     (princ "\n 第二参考点:")
     (command pause)
    ) ;for (= c1 6011)
 　 ;;else
    (T (princ "\n 未定义的菜单"))
   ) ;for cond
   (princ "\n F2/F3/F4/F5/ESC/Return /下一点:")
   ) ;for (cond (= b 4))
   (T (home)) ;for else
  ) ;for cond
 ) ;for while
) ;for defun pull
;; draw() , 绘制直线子程序
(defun draw ()
 (while (/= b1 1)
  (if (= b 3) (progn
   (command"line" pstart pend "")
   (princ "\n F2/F3/F4/F5/ESC/Return /下一点:")
   (setq b 0 b1 1)
   (setq pstart pend)
  )); for if
  (pull)
 ) ;for while
 (grdraw pstart pend -1 0)
 (grdraw pend pframe -1 0)
) ;for defun draw
;;;;主程序
(defun c:os (/ b b1 b2 c pstart pend pframe plast ang2
 　 dist scmd ccoords olderr cosmode)
;;; an0 len0 are defined out program
 (init)
 (draw)
 (princ "\n")
 (redraw)
 (setq *error* olderr)
 (setvar "cmdecho" scmd)
 (setvar "osmode" cosmode)
 (setvar "coords" ccoords)
 (princ "\n\n\t ------角度捕捉2.0版------\n")
 (princ "\n\n\t**宁波大学建筑设计研究院--程建华,1996**\n")
 (princ)
) ;for defun os

xyz2009xyz · 发表于 2010-8-17 21:39:00

下面是执行过程，在选择第一个点之后就退出了，还是不行啊！

命令: OS
系统变量【 CMDECHO 】从值〖1 〗变到〖 0 〗
系统变量【 OSMODE 】从值〖15359 〗变到〖 0 〗
请输入直线第一点:
F2/F3/F4/F5/ESC/Return /下一点::
Error:参数类型错误: fixnump: nil
系统变量【 CMDECHO 】从值〖0 〗变到〖 1 〗
系统变量【 OSMODE 】从值〖0 〗变到〖 15359 〗n
--多谢使用角度捕捉2.0版,程序非正常结束--!

ZZXXQQ · 发表于 2010-8-18 20:15:00

是抄别人的程序吧。三楼改了。再试试。

xyz2009xyz · 发表于 2010-8-18 20:18:00

呵呵:-)，这本来就是别人的程序啊！下面的署名估计就是原作者，我保留了版权信息啊，原封不动，没改！

账号		自动登录	找回密码
密码			注册