求助：三点画矩形的LISP

zuoluo007

   由于工作需要，经常描图，是那种地面房屋的图（矩形，矩形的边与UCS的X、Y轴不平行），虽然cad2010提供的画矩形工具可以在选择第一点后，输入R进行旋转，但量大的时候，总觉得不方便，我的思路是：在屏幕上用鼠标选择矩形某条边上的两点角点，同时实现UCS的X轴自动调整与这条边（这两个角点连成的边）对齐，然后在屏幕上用鼠标选择第三个角点，自动画出矩形。也就是用三点画矩形。

   初学LISP，很感兴趣，但还是无能为力，恳请大侠帮忙了，跪谢。

zuoluo007

能用，非常感谢liu_kunlun，高手啊，我何时才能达到这个水平。。。。。感激之情无以言表。。。。。

jhzxj

liu_kunlun 发表于 2010-7-1 17:02
给你一个动态的
(defun c:tttt (/ os pt1 pt2 pt3 pt4 ag0 ag len ent ct in k)  (setq os (getvar " ...

加载运行挺好用的，就是执行命令出现"瑙掔偣1:"是怎么回事？请指教一下，谢谢！

zmzk

留个脚印，应该是有需要的！

liu_kunlun

(defun c:tttt (/ pt1 pt2 pt3 pt4 ag0 ag len)
  (while (and (setq pt1 (getpoint "角点1:"))
           (setq ag0  (getangle pt1 "角度:"))
           (setq pt3 (getpoint pt1 "对角点:"))
           (setq len (distance pt1 pt3) ag  (angle pt1 pt3) )
           (setq pt2 (polar pt1 ag0 (* len (cos (- ag ag0)))))
           (setq pt4 (polar pt1 (+ (/ pi 2.) ag0) (* len (sin (- ag ag0)))))
        )
        (command "pline" pt1 pt2 pt3 pt4 "c" "")
  )
  (princ)
)

liu_kunlun

给你一个动态的

(defun c:tttt (/ os pt1 pt2 pt3 pt4 ag0 ag len ent ct in k)
  (setq os (getvar "osmode")) 
  (while (and (setq pt1 (getpoint "\n角点1:"))
              (setq ag0  (getangle pt1 "角度:"))
       (progn (princ "对角点:") (setq ct t))
       (progn
  (setq ct t k t ent nil)
         (while ct
    (setq in (grread 1))
    (cond
       (  (= 5 (car in))
                        (setq pt3 (cadr in))
                        (setq len (distance pt1 pt3) ag  (angle pt1 pt3) )
                        (setq pt2 (polar pt1 ag0 (* len (cos (- ag ag0)))))
                        (setq pt4 (polar pt1 (+ (/ pi 2.) ag0) (* len (sin (- ag ag0)))))
          (if ent (command "erase" ent ""))
          (setvar "osmode" 0)
          (command "pline" pt1 pt2 pt3 pt4 "c" )
          (setvar "osmode" os)
          (setq ent (entlast))
                     )
       (  (= 3 (car in))
          (setq pt3 (cadr in))
                        (setq len (distance pt1 pt3) ag  (angle pt1 pt3) )
                        (setq pt2 (polar pt1 ag0 (* len (cos (- ag ag0)))))
                        (setq pt4 (polar pt1 (+ (/ pi 2.) ag0) (* len (sin (- ag ag0)))))
          (if ent (command "erase" ent ""))
          (setvar "osmode" 0)
          (command "pline" pt1 pt2 pt3 pt4 "c" )
          (setvar "osmode" os)
          (setq ent (entlast))
          (setq ct nil)
       )
       (  (equal '(11 0) in)
          (if ent (command "erase" ent ""))
          (setq ct nil k nil)
       )
       (t)
    )  
         )
         k
       ) 
    ) 
       
  )
  (setvar "osmode" os)
  (princ)
)

killer9806

学习一下， 不错！

xyp1964

2. ;; sdmt(三点描图)　2010年7月1日
3. (defun c:sdmt (/ p1 p2 rad mode motion code pt p3 p4 s2)
4.   (while (and (setq p1 (getpoint "\n基点<退出>: "))
5.        (setq p2 (getpoint p1 "\n方向点<退出>: "))
6.   )
7.     (princ "\n对角点: ")
8.     (setq rad  (angle p1 p2)
9.    rad1 (+ rad (* pi 0.5))
10.    mode t
11.     )
12.     (while mode
13.       (setq MOTION (grread t 15 0)
14.      CODE   (car MOTION)
15.      p3    (xyp-Grvecs-Osnap (cadr MOTION))
16.      p2    (inters p1 p2 p3 (polar p3 rad1 10) nil)
17.      p4    (inters p1 (polar p1 rad1 10) p3 (polar p3 rad 10) nil)
18.       )
19.       (redraw)
20.       (cond ((= CODE 5) (XYP-GRVECS-PTLST (list p1 p2 p3 p4 p1) 3))
21.      ((= CODE 3)
22.       (setq s2 (xyp-Entmake-lwPolyline (list p1 p2 p3 p4) t)
23.      mode nil
24.       )))))
25.   (princ))

;; sdmt(三点描图)　2010年7月1日 (defun c:sdmt (/ p1 p2 rad mode motion code pt p3 p4 s2)   (while (and (setq p1 (getpoint "\n基点<退出>: "))        (setq p2 (getpoint p1 "\n方向点<退出>: "))   )     (princ "\n对角点: ")     (setq rad  (angle p1 p2)    rad1 (+ rad (* pi 0.5))    mode t     )     (while mode       (setq MOTION (grread t 15 0)      CODE   (car MOTION)      p3    (xyp-Grvecs-Osnap (cadr MOTION))      p2    (inters p1 p2 p3 (polar p3 rad1 10) nil)      p4    (inters p1 (polar p1 rad1 10) p3 (polar p3 rad 10) nil)       )       (redraw)       (cond ((= CODE 5) (XYP-GRVECS-PTLST (list p1 p2 p3 p4 p1) 3))      ((= CODE 3)       (setq s2 (xyp-Entmake-lwPolyline (list p1 p2 p3 p4) t)      mode nil       )))))   (princ))

461045462

2楼与6楼的方法都很好。

请问能够画成多点的就更理想。即在一条线的任意一边点击一下，输入距离，就画出一条垂直线。虽然在正交的模式下可以画，但有时图形不是水平方向的。

想学习修改一下，还是无能为力，恳求高手指教。

谢谢

elitefish

建议 先使用UCS 转换坐标系 再使用 plan 旋转屏幕

461045462

使用坐标转换的工作量很大，像那种地面房屋的图，数量较多，不一定就是矩形，而是由多点组成的图形。

如果能左右两边点击，也就是指出哪个方向90度，再给一个距离，画出一个直角线，就快多了。不需要去旋转。

恳请大侠帮忙,谢谢！

lht

(defun c:hxjx ()
   (setvar "osmode" 0)
   (setvar "cmdecho" 0)
      (setq pa (getpoint "\n第一角点：")
            pb (getpoint "\n第二角点：")
            pc (getpoint "\n第三角点：")
            la (distance pa pb)
            lb (distance pb pc)
            lc (sqrt (+ (* la la) (* lb lb)))
            aa (angle pa pb)                ;计算与x轴的夹角aa
            ab (atan (/ lb la))
            ac (+ aa (/ pi 2))
            pc (Polar  Pa  (+ aa ab)  lc)
            pd (Polar  Pa ac lb)
      )
      (command "pline" pa pb pc pd "c")
    (setvar "osmode" 47)

)
                 (prompt "<<画斜矩形>>启动命令:hxjx")
                    (princ)