兰州人 发表于 2008-8-7 15:53:00

[转帖]LISP模拟stretch一例

<p><a href="http://en.allexperts.com/q/AutoCAD-1029/2008/7/Scale-stretch-behavior.htm">http://en.allexperts.com/q/AutoCAD-1029/2008/7/Scale-stretch-behavior.htm</a></p><p></p><p>(defun mstrerr (msg)<br/>&nbsp;(if msg (princ msg))<br/>&nbsp;(command "_.undo" "_end")<br/>&nbsp;(if olderr (setq *error* olderr))<br/>&nbsp;(princ)<br/>)<br/><br/>(defun c:mstr (/ p1 p2 p3 p4 olderr)<br/>&nbsp;&nbsp;(command "_.undo" "_g")<br/>&nbsp;&nbsp;(setq olderr *error* *error* mstrerr)<br/>&nbsp;&nbsp;(setq p1 (getpoint "\nOne corner: &nbsp;"))<br/>&nbsp;&nbsp;(initget 32)<br/>&nbsp;&nbsp;(setq p2 (getcorner p1 "\nOther corner: &nbsp;"))<br/>&nbsp;&nbsp;(setq p3 (getpoint "\nStarting point: &nbsp;"))<br/>&nbsp;&nbsp;(initget 32)<br/>&nbsp;&nbsp;(setq p4 (getpoint p3 "\nEnding point: &nbsp;"))<br/>&nbsp;&nbsp;(command "_.stretch" "c" p1 p2 "" p3 p4)<br/>&nbsp;&nbsp;(setq resp (strcase (getstring "\nContinue or eXit? &nbsp;")))<br/>&nbsp;&nbsp;(While (= resp "C")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(setq p1 (getpoint "\nOne corner: &nbsp;"))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(initget 32)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(setq p2 (getcorner p1 "\nOther corner: &nbsp;"))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(command "_.stretch" "c" p1 p2 "" p3 p4)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(setq resp (strcase (getstring "\nContinue or eXit? &nbsp;")))<br/>&nbsp;&nbsp;)<br/>&nbsp;(command "_.undo" "_end")<br/>&nbsp;&nbsp;(princ)<br/>)<br/></p>
页: [1]
查看完整版本: [转帖]LISP模拟stretch一例