找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 934|回复: 0

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

[复制链接]
发表于 2009-4-17 11:33:21 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×
转帖特定角度及长度捕捉的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
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-11-22 05:29 , Processed in 0.213683 second(s), 31 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表