yswoyh 发表于 2007-4-16 19:14:00

画线能否改成不移屏!

<p>(defun c:pp ()<br/>&nbsp; (setvar "cmdecho" 0)<br/>&nbsp; (command "undo" "g")<br/>&nbsp; (if (setq point (getpoint "\nfrom point"))<br/>&nbsp;&nbsp;&nbsp; (progn<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq draw t<br/>&nbsp;&nbsp;&nbsp;&nbsp; ss&nbsp; (ssadd)<br/>&nbsp;&nbsp;&nbsp;&nbsp; pts&nbsp; nil<br/>&nbsp;&nbsp;&nbsp;&nbsp; pts&nbsp; (cons point pts)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (while draw<br/>&nbsp;(initget 128)<br/>&nbsp;(setq point (getpoint (car pts) "\nUndo/Reverse/Close/&lt;Endpoint to line&gt;:"))<br/>&nbsp;(cond<br/>&nbsp;&nbsp; ((= point "u")<br/>&nbsp;&nbsp;&nbsp; (if (= (length pts) 1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (print "can't undo.")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (progn<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq pts (cdr pts))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (command "zoom" "c" (car pts) "100")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (command "erase" (entlast) "")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp; )<br/>&nbsp;&nbsp; ((= point "r")<br/>&nbsp;&nbsp;&nbsp; (command "zoom" "c" (car (reverse pts)) "100")<br/>&nbsp;&nbsp;&nbsp; (setq point (getpoint (car (reverse pts))))&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; (command "pline" (car (reverse pts)) point "")<br/>&nbsp;&nbsp;&nbsp; (command "zoom" "c" point "100")<br/>&nbsp;&nbsp;&nbsp; (setq pts (cons point (reverse pts))<br/>&nbsp;&nbsp; ss&nbsp; (ssadd (entlast) ss)<br/>&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp; ((= (type point) 'list)<br/>&nbsp;&nbsp;&nbsp; (command "zoom" "c" point "100")<br/>&nbsp;&nbsp;&nbsp; (command "pline" (car pts) point "")<br/>&nbsp;&nbsp;&nbsp; (setq pts (cons point pts)<br/>&nbsp;&nbsp; ss&nbsp; (ssadd (entlast) ss)<br/>&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp; )<br/>&nbsp;&nbsp; ((or (= point nil) (= point "e") (= point "c"))<br/>&nbsp;&nbsp;&nbsp; (command "pline" (car pts) (car pts) "")<br/>&nbsp;&nbsp;&nbsp; (setq ss (ssadd (entlast) ss))<br/>&nbsp;&nbsp;&nbsp; (setq draw nil)<br/>&nbsp;&nbsp; )<br/>&nbsp;&nbsp; (t (print "输入错误!只能输入点坐标或关键字."))<br/>&nbsp;)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (if (&gt; (length pts) 1)<br/>&nbsp;(progn<br/>&nbsp;&nbsp; (command "pline")<br/>&nbsp;&nbsp; (while pts<br/>&nbsp;&nbsp;&nbsp;&nbsp; (command (car pts))<br/>&nbsp;&nbsp;&nbsp;&nbsp; (setq pts (cdr pts))<br/>&nbsp;&nbsp; )<br/>&nbsp;&nbsp; (if (= point "c")<br/>&nbsp;&nbsp;&nbsp;&nbsp; (command "c")<br/>&nbsp;&nbsp;&nbsp;&nbsp; (command "")<br/>&nbsp;&nbsp; )<br/>&nbsp;&nbsp; (command "erase" ss "")<br/>&nbsp;)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<br/>&nbsp;&nbsp;&nbsp; )<br/>&nbsp; )<br/>&nbsp; (command "undo" "e")<br/>&nbsp; (prin1)<br/>)</p>

yswoyh 发表于 2007-4-16 19:16:00

<p>在里面加上圆弧!!!就和CAD里的pline差不多的功能!!</p>

zml84 发表于 2007-4-17 08:47:00

描绘等高线是舒服多了！

zml84 发表于 2007-4-17 11:39:00

来个精简版本的，代码如下：
;;;功能：绘制线段时自动移动窗口
;;;日期：zml84 于 2007-04-17
(defun c:tt (/ pt0 ss pt1)
    (if (setq pt0 (getpoint "\n第一点："))
(progn
   (setq ss (ssadd))
   ;;绘制各段直线
   (while (setq pt1 (getpoint pt0 "\n下一点："))
(command "._pan" pt1 (getvar "VIEWCTR"))
(command "._line" pt0 pt1 "")
(setq ss(ssadd (entlast) ss)
      pt0 pt1
)
   )
   ;;将各段直线连接成PLINE
   (if (> (sslength ss) 0)
(command "._pedit" (ssname ss 0) "y" "j" ss "" "")
   )
)
    )
    (princ)
)

434939575 发表于 2015-3-16 15:52:17

zml84 发表于 2007-4-17 11:39 static/image/common/back.gif
来个精简版本的，代码如下：

太强大了！

wline 发表于 2024-7-2 20:04:15

zml84 发表于 2007-4-17 11:39
来个精简版本的，代码如下：

厉害了，刚看到源码，就找到精简版的了
页: [1]
查看完整版本: 画线能否改成不移屏!