[分享]：转帖特定角度及长度捕捉的lsp,看看这个程序能否用，好像有点小毛病。

znchssy

转帖特定角度及长度捕捉的lsp,看看这个程序能否用，好像有点小毛病。
特定角度及长度捕捉在AutoCAD中的实现方法

三、源程序清单

　;; 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(), 十字光标投影到相应的捕捉角度上后,以用户设定的长度

　;; 捕捉计算落点

　(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

本文来源于【天府教程】，原文链接：http://www.tfxy.com/pmdesign/2008/0412/article_2896.html