关于画矩形的lsp，求大大优化一下呢

酷酷提 发表于 2022-4-27 03:02:30

本帖最后由酷酷提于 2022-4-27 03:20 编辑

源码来自于：Gu_xl 大大
遇到的问题是：这个源码是以拾取点的中心为基点画矩形

希望得到解决方案是：以拾取基点为基础，鼠标向右上方移动，就以基点为基础向右上方画矩形，鼠标往左上方移动，就以基点为基础向左上方画矩形，就是有可能鼠标会往左上左下，右上右下方向移动

(defun c:tt (/ w p1 p2 ang )
(initget 7)
(setq w (getdist "\n**输入宽度:"))

(princ "\n**输入")
(while (and
      (setq p1 (getpoint "第一点："))
      (setq p2(getpoint p1 "\n**第二点："))
      )
(setq ang (angle p1 p2) l (distance p1 p2))
(entmake
   (list
   '(0 . "LWPOLYLINE")
   '(100 . "AcDbEntity")
   '(100 . "AcDbPolyline")
   '(90 . 4)
   '(70 . 1)
   '(43 . 0.0)
   '(38 . 0.0)
   '(39 . 0.0)
   (cons 10 (trans (setq p(polar p1 (+ ang (* 0.5 pi)) (* 0.5 w))) 1 0))
   (cons 10 (trans (setq p (polar p ang l)) 1 0))
   (cons 10 (trans (setq p (polar p (- ang (* 0.5 pi)) w)) 1 0))
   (cons 10 (trans (setq p (polar p (+ pi ang) l)) 1 0))
   )
   )
(princ "\n**继续输入")
)
(princ)
)

xj6019 发表于 2022-4-27 03:02:31

是这么玩的吗
(defun c:NM (/ h p1 p2 pa2 pa3 pa4 w xp1 xp2 yp1 yp2)
(setq h(getdist "\n**输入长度:"))
(setq w(getdist "\n**输入宽度:"))
(if(andh w)
(progn
(while
(setq p1 (getpoint "\n第一点:"))
(setq p2 (getpoint "\n第二点:" p1))
(setq xp1(car p1)
yp1(cadrp1)
xp2(car p2)
yp2(cadrp2))
(cond
((and(< xp1 xp2 )(< yp1 yp2)) ;---------------------------------------------------------01
(setq pa2(polar p1 0 w)
pa3(polar pa2 (* 0.5 pi) h)
pa4(polar pa3 PI w)
)
(entmake
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(90 . 4)
'(70 . 1)
'(43 . 0.0)
'(38 . 0.0)
'(39 . 0.0)
(cons 10 p1)(cons 10 pa2)(cons 10 pa3)(cons 10 pa4)

)
)
)
((and(> xp1 xp2 )(< yp1 yp2)) ;右下--》左上 ;---------------------------------------------------------02
(setq pa2(polar p1 PIw)
pa3(polar pa2 (* 0.5 pi) h)
pa4(polar pa3 0 w)
)
(entmake
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(90 . 4)
'(70 . 1)
'(43 . 0.0)
'(38 . 0.0)
'(39 . 0.0)
(cons 10 p1)(cons 10 pa2)(cons 10 pa3)(cons 10 pa4)

)
)
)

((and(< xp1 xp2 )(> yp1 yp2)) ;左上--》右下;---------------------------------------------------------03
(setq pa2(polar p1 0 w)
pa3(polar pa2 (* 1.5 pi) h)
pa4(polar pa3 PI w)
)
(entmake
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(90 . 4)
'(70 . 1)
'(43 . 0.0)
'(38 . 0.0)
'(39 . 0.0)
(cons 10 p1)(cons 10 pa2)(cons 10 pa3)(cons 10 pa4)

)
)
)

((and(> xp1 xp2 )(> yp1 yp2)) ;右上--》左下;---------------------------------------------------------04
(setq pa2(polar p1 PI w)
pa3(polar pa2 (* 1.5 pi) h)
pa4(polar pa3 0 w)
)
(entmake
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(90 . 4)
'(70 . 1)
'(43 . 0.0)
'(38 . 0.0)
'(39 . 0.0)
(cons 10 p1)(cons 10 pa2)(cons 10 pa3)(cons 10 pa4)

)
)
)
)
)
)
)
(princ)
)

自贡黄明儒 发表于 2022-4-27 07:53:15

可能要用grread,以判断方向

yshf 发表于 2022-4-27 10:38:54

;试试这个画水平或垂直矩形
(defun c:tt (/ w p1 p2 ang )
(initget 7)
(setq pi0.5 (* 0.5 pi))
(setq pi1.5 (* 1.5 pi))
(setq w (getdist "\n**输入宽度:"))
(setq h (getdist "\n**输入高度:"))
(princ "\n**输入")
(while (and
      (setq p1 (getpoint "基点："))
      (setq pp(getpoint p1 " 方向指示点："))
      )
(setq ang (angle p1 pp))
(cond ( (and (< 0.0 ang) (< ang pi0.5))
      (setq ang1 0.0)
      (setq dang pi0.5)
   )
   ( (= ang pi0.5)
         (setq ang1 pi0.5)
      (setq dang pi0.5)
   )
   ( (and (< pi0.5 ang) (<= ang pi))
         (setq ang1 pi)
(setq dang (- pi0.5))
   )
   ( (and(< pi ang) (< ang pi1.5))
         (setq ang1 pi)
         (setq dang pi0.5)
   )
   ( (= ang pi1.5)
         (setq ang1 pi1.5)
      (setq dang pi0.5)
   )
   (t
         (setq ang1 0)
         (setq dang (- pi0.5))
   )
)
(setq p2 (polar p1 ang1 w))
(setq p3 (polar p2 (+ ang1 dang) h))
(setq p4 (polar p1 (+ ang1 dang) h))
(entmake
   (list
   '(0 . "LWPOLYLINE")
   '(100 . "AcDbEntity")
   '(100 . "AcDbPolyline")
   '(90 . 4)
   '(70 . 1)
   '(43 . 0.0)
   '(38 . 0.0)
   '(39 . 0.0)
   (cons 10 p1)
   (cons 10 p2)
   (cons 10 p3)
   (cons 10 p4)
   )
   )
(princ "\n**继续输入")
)
(princ)
)

xj6019 发表于 2022-4-27 11:41:02

效果大体是这样的

酷酷提 发表于 2022-4-27 13:57:52

xj6019 发表于 2022-4-27 11:41
效果大体是这样的

老师，请问一下这个输入了长宽后，点击画面，没有出现矩形是什么情况呢

酷酷提 发表于 2022-4-27 14:06:45

yshf 发表于 2022-4-27 10:38
;试试这个画水平或垂直矩形
(defun c:tt (/ w p1 p2 ang )
(initget 7)

老师，请问一下，这个矩形不往鼠标移动方向画矩形，是还需要怎么弄吗？
比如我鼠标往左下角移动点击，这个矩形还是往右边画了一个18的矩形

bai2000 发表于 2022-4-27 14:49:09

关掉正交就行

酷酷提 发表于 2022-4-27 15:01:57

xj6019 发表于 2022-4-27 03:02
是这么玩的吗
(defun c:NM (/ h p1 p2 pa2 pa3 pa4 w xp1 xp2 yp1 yp2)
(setq h(getdist "\n**输入 ...

感谢老师，现在这个代码是先输入竖向的数字，再输入横向的数字，如果我想先输入横向数字，再输入竖向数字，是调整哪几个数值呢？

xj6019 发表于 2022-4-27 15:08:14

本帖最后由 xj6019 于 2022-4-28 16:13 编辑

酷酷提发表于 2022-4-27 14:06
老师，请问一下，这个矩形不往鼠标移动方向画矩形，是还需要怎么弄吗？
比如我鼠标往左下角移动点击， ...
试试这样的，彻底改了一下，输入的时候要保证长度大于宽度，然后画的时候会根据鼠标点的第二点的位置画矩形，规则就是360度分了8份，看你鼠标点在哪个区域里，然后根据这个来定画出来的矩形的方向，萌新捣鼓这个有点费脑，咱也收俩币玩玩，嘿嘿

2.0
已经更新，请再试试，现在可以每次指定长度了，宽度在开始指定，每画完一个重新指定长度后再画第二个，然后依次类推，每次都需要先指定长度后，再画矩形，看看这样符合你的要求了吧！

3.0
按你的要求已经改成先指定点再输入长度了

4.0
改为了动态绘制，指定点指定长度后，可鼠标滑动预览实际效果，转到合适方向后，左键确认，也可以直接鼠标指定完点后，再鼠标指定长度，预览效果调整好方向后，左键绘制，循环操作。

页: [1] 2 3 4

明经CAD社区's Archiver

关于画矩形的lsp，求大大优化一下呢