想要1个lsp程序：画一个矩形，对角线是连起来的，并且可让它自动转到指定的图层，...

李青松 · 发表于 2013-10-15 11:59

想要1个lsp程序：画一个矩形，对角线是连起来的，并且可让它自动转到指定的图层，程序里面指定的图层可以修改

emk · 发表于 2013-10-15 20:35

这个很简单吧，指定对角两点，通过两点计算矩形另外两点，四个点都有了，就简单了啊，图层可以先指定，在绘图钱切换到指定图层，画完后切换回初始状态即可

xyp1964 · 发表于 2013-10-15 23:04

;; 云共享 http://yunpan.cn/QXQKsW9gAPmpF
(defun c:tt (/ i ss s1 pt)
(xyp-CMDLA0)
(while (and (setq p1 (getpoint "\n基点<退出>: "))
(setq p2 (getcorner p1 "\n基点<退出>: "))
)
(xyp-MkLaCo "TEST3" 3)
(setq s1 (xyp-rectang p1 p2))
(xyp-MkLaCo "TEST4" 4)
(xyp-line (xyp-9pt s1 1) (xyp-9pt s1 9))
(xyp-line (xyp-9pt s1 3) (xyp-9pt s1 7))
)
(xyp-CMDLA1)
)

李青松 · 发表于 2013-10-16 14:19

运行版主的程序时出现这个
错误: no function definition: XYP-CMDLA0

Andyhon · 发表于 2013-10-16 14:31

XYP-***
Ref:
http://bbs.mjtd.com/thread-107932-1-1.html

ZZXXQQ · 发表于 2013-10-16 23:12

(defun c:tt ()
(setvar "CMDECHO" 0)
(while (and (setq p1 (getpoint "\n基点<退出>: "))
(setq p2 (getcorner p1 "\n基点<退出>: "))
)
(command "-LAYER" "M" "TEST3" "C" 3 "" "")
(command "_.RECTANG" p1 p2)
(command "-LAYER" "M" "TEST4" "C" 4 "" "")
(command "_.LINE" p1 p2 "" "_.LINE" (list (car p1) (cadr p2)) (list (cadr p1) (car p2)) "")
)
(setvar "CMDECHO" 0)
(princ)
)

清风明月名字 · 发表于 2013-10-17 08:22

上一楼最后一个端点XY反掉了，是错误的
(defun c:tt ()
(setvar "CMDECHO" 0)
(while (and (setq p1 (getpoint "\n基点，即矩形的第1角点<退出>: "))
            (setq p2 (getcorner p1 "\n基点，即矩形的第2角点<退出>: "))
      )
  (command "-LAYER" "M" "TEST3" "C" 3 "" "")
  (command "_.RECTANG" p1 p2)
  (command "-LAYER" "M" "TEST4" "C" 4 "" "")
  (command "_.LINE" p1 p2 "" "_.LINE" (list (car p1) (cadr p2)) (list (car p2)(cadr p1) ) "")
)
(setvar "CMDECHO" 0)
(princ)
)

李青松 · 发表于 2013-10-17 09:42

上楼的程序中，在输入矩形的第2个角点增加用输入相对坐标的方向就好了，比如@25,50
也就是可以用两种方式输入矩形的第2个角点

donghuidong2003 · 发表于 2013-10-17 18:26

看一下这个呢，行不行

(defun C:SS ()
  (graphscr)
  (setq old (getvar "cmdecho"))
  (setq plold (getvar "plinewid"))
  (setvar "cmdecho" 0)
  (setvar "plinewid" 0.0)
  (setq pt1 (getpoint "\nstart point"))
  (setq pt3 (getcorner pt1 "\nend point"))
  (setq pt2 (list (car pt3) (cadr pt1)))
  (setq pt4 (list (car pt1) (cadr pt3)))
  (setq oldlay (getvar "clayer"))
  (command ".layer"    "Make"  "Gasket"    "color" "4"    ""
   "lt"    ""    ""    "lw"    "0.0" ""    "set"
   "Gasket"    ""
   )
  (command ".pline" pt1  pt2 pt3 pt4 pt1 pt3 pt2 pt4 "")
  (command ".layer" "set" oldlay "")
  (COMMAND "MMM" "")
  (setvar "cmdecho" old)
  (setvar "plinewid" plold)
  (princ)
)

1993063 · 发表于 2013-10-18 00:57

这个原来以前就有了,

(defun c:tt ( / p1 p2 p3 p4)(princ "\n")
(while (and(setq p1 (getpoint "\r第一点:"))(setq p2 (getcorner p1 "\r下一点:")))
(progn
(setq p3 (list (car p1) (cadr p2)) p4 (list (car p2) (cadr p1)))
(entmake (list '(0 . "LINE") (cons 10 p1) (cons 62 1) (cons 11 p2) '(8 . "TEST1")))
(entmake (list '(0 . "LINE") (cons 10 p3) (cons 62 1) (cons 11 p4) '(8 . "TEST1")))
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(8 . "TEST2") '(100 . "AcDbPolyline") (cons 62 1)(cons 90 4) (cons 10 p1) (cons 10 p3) (cons 10 p2) (cons 10 p4) (cons 70 1)))
)
)
(princ)
) ;;图层名自己改吧

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

[提问] 想要1个lsp程序：画一个矩形，对角线是连起来的，并且可让它自动转到指定的图层，...

本帖子中包含更多资源

相关帖子