画线能否改成不移屏!

yswoyh

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

yswoyh

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

zml84

描绘等高线是舒服多了！

zml84

来个精简版本的，代码如下：

2. ;;;功能：绘制线段时自动移动窗口
3. ;;;日期：zml84 于 2007-04-17
4. (defun c:tt (/ pt0 ss pt1)
5.     (if (setq pt0 (getpoint "\n第一点："))
6. (progn
7.      (setq ss (ssadd))
8.      ;;绘制各段直线
9.      (while (setq pt1 (getpoint pt0 "\n下一点："))
10.   (command "._pan" pt1 (getvar "VIEWCTR"))
11.   (command "._line" pt0 pt1 "")
12.   (setq ss  (ssadd (entlast) ss)
13.         pt0 pt1
14.   )
15.      )
16.      ;;将各段直线连接成PLINE
17.      (if (> (sslength ss) 0)
18.   (command "._pedit" (ssname ss 0) "y" "j" ss "" "")
19.      )
20. )
21.     )
22.     (princ)
23. )

;;;功能：绘制线段时自动移动窗口 ;;;日期：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

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

太强大了！

wline

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

厉害了，刚看到源码，就找到精简版的了