[求助]：请高手改一下这个矩形LISP

断点 · 发表于 2007-7-13 12:13:59

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

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

×

在论坛里找到一个矩形LISP，感觉好用，但有点不习惯的是第一点是矩形的中心点，请高手改为一个角点。谢谢！

(defun c:bx (/ os OO pt w l w2 l2 ptx pty pt1 pt2 pt3 pt4 )
      (setq os (getvar "osmode")
            OO (getvar "orthomode")
      ) ;
      (setvar "cmdecho" 0)
      (setvar "orthomode" 1)
      (setvar "osmode" 3007)
      (while
      (setq pt (getpoint "\n please input center point>>"))
      (setvar "osmode" 0)
      (setq l (getdist "\n pletse input l:"))
      (setq w (getdist (strcat "\n please input w:<"
                              (rtos l)
                              ">"
      )    )       )
      (if (null w)
         (setq w l)
      )
      (setq w2 (/ w 2)
            l2 (/ l 2)
            ptx (car pt)
            pty (cadr pt)
            pt1 (list (+ ptx l2) (- pty w2))
            pt2 (list (+ ptx l2) (+ pty w2))
            pt3 (list (- ptx l2) (+ pty w2))
            pt4 (list (- ptx l2) (- pty w2))
      )
      (command "Pline" pt1 pt2 pt3 pt4 "c")
      (setvar "osmode" 3007)
      )
      (setvar "osmode" os)
      (setvar "orthomode" OO)
      (princ)
      )

carrot1983 · 发表于 2007-7-13 12:25:45

如果楼主懂一点点lisp，可以用command矩形！
来这里吧，这里回贴有时候回不了！
http://acad.net.cn/viewthread.php?tid=181&extra=page%3D1

gysjy · 发表于 2007-7-13 18:19:31

[FONT=courier new]
(defun c:bx (/ os OO pt w l ptx pty pt1 pt2 pt3 )
(setq os (getvar "osmode")
OO (getvar "orthomode")
) ;
(setvar "cmdecho" 0)
(setvar "orthomode" 1)
(setvar "osmode" 3007)
(while
(setq pt (getpoint "\n please input center point>>"))
(setvar "osmode" 0)
(setq l (getdist "\n pletse input l:"))
(setq w (getdist (strcat "\n please input w:<" (rtos l) ">")))
(if (null w)
(setq w l)
)
(setq ptx (car pt)
pty (cadr pt)
pt1 (list (+ ptx l) pty)
pt2 (list (+ ptx l) (+ pty w))
pt3 (list ptx (+ pty w))
)
(command "Pline" pt pt1 pt2 pt3 "c")
(setvar "osmode" 3007)
)
(setvar "osmode" os)
(setvar "orthomode" OO)
(princ)
)
[/FONT]

zml84 · 发表于 2007-7-13 19:13:49

(defun C:BX (/ PT PT1 L W)
(while (setq PT (getpoint "\n please input center point>>"))
(if (setq L (getdist PT "\n pletse input l:"))
(progn
(setq PT1 (polar PT 0 L))
(if (setq W (getdist PT
(strcat "\n please input w:<"
(rtos L)
">"
)
)
)
(setq PT1 (polar PT1 (* 0.5 pi) W))
(setq PT1 (polar PT1 (* 0.5 pi) L))
)
(command "_.rectang" "non" PT "non" PT1)
)
)
)
(princ)
)

更多关于矩形的讨论参见：http://acad.net.cn/viewthread.ph ... tra=page%3D1#pid460

断点 · 发表于 2007-7-13 21:31:25

好用。谢谢楼上几位高手！

lijie70000 · 发表于 2009-11-13 18:26:58

汗。下载不了啊

yxianfo · 发表于 2010-3-22 00:29:56

最初由 lijie70000 发布
[B]汗。下载不了啊 [/B]

你可将各楼的程序代码分别复制到“记事本”中保存下来，再将该文件的扩展名“.txt”改成“.lsp”就成为lsp程序文件了。

3楼的程序若改为下面的会更好用些。

(defun c:bx (/ os or au po h w px py p1 p2 p3 )
  (setq os (getvar "osmode")
      or (getvar "orthomode")
      au (getvar "autosnap")
)
  (setvar "cmdecho" 0)
  (setvar "orthomode" 1)
  (setvar "osmode" 575)
  (while
(setq po (getpoint "\n 指定矩形左下角点"))
(setvar "osmode" 0)
(setq w (getdist po "\n 指定矩形水平宽度:"))
(setq h (getdist po (strcat "\n 指定矩形垂直高度（确认则绘制正方形）<" (rtos w) ">：")))

(if (null h)
(setq h w)
)
(setq px (car po)
      py (cadr po)
      p1 (list (+ px w) py)
      p2 (list (+ px w) (+ py h))
      p3 (list px (+ py h))
   )
(command "Pline" po p1 p2 p3 "c")
(setvar "osmode" 575)
);while
(setvar "osmode" os)
(setvar "orthomode" or)
(setvar "autosnap" au)
(princ)
)

;;; 同理，1楼的可改为

(defun c:jx (/ os or au po h w h2 l2 px py p1 p2 p3 p4 )
  (princ "以指定矩形中心点来绘制矩形")
  (setq os (getvar "osmode")
      or (getvar "orthomode")
      au (getvar "autosnap")
)
  (setvar "cmdecho" 0)
  (setvar "orthomode" 1)
  (setvar "osmode" 575)
  (while
  (setq po (getpoint "\n 指定矩形的中心点"))
  (setvar "osmode" 0)
  (setq w (getdist po "\n 指定矩形水平宽度:"))
  (setq h (getdist po (strcat "\n 指定矩形垂直高度（确认则绘制正方形）<"(rtos w)">：")))
  (if (null h)
(setq h w)
  )
(setq h2 (/ h 2)
   w2 (/ w 2)
   px (car po)
   py (cadr po)
   p1 (list (+ px w2) (- py h2))
   p2 (list (+ px w2) (+ py h2))
   p3 (list (- px w2) (+ py h2))
   p4 (list (- px w2) (- py h2))
   )
  (command "Pline" p1 p2 p3 p4 "c")
  (setvar "osmode" 575)
  ) ;while
  (setvar "osmode" os)
  (setvar "orthomode" or)
  (setvar "autosnap" au)
  (princ)
)

账号		自动登录	找回密码
密码			立即注册

[求助] [求助]：请高手改一下这个矩形LISP

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

相关帖子