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

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



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

网友答: (defun C:rect3p (/ PT1 PT2 PT3 PT4 PT01 PT02 PT03 PT04 ANG ANG0 H dist0 dist2)
  (prompt "\n指定矩形一条边线角点PT1和PT2：")
  (while (setq PT1 (getpoint "\n第一点PT1:"))
    (if (setq PT2 (getpoint PT1 "\n第二点PT2:"))
      (progn
        (setq ANG (angle PT1 PT2)
              ANG0 (angle PT1 PT2)
              ANG (+ ANG (* 0.5 pi))
        )
       (setq PT3 (getpoint "\n指定线宽点PT3:"))
        (setq PT01 PT1)
        
        ;;; 计算PT3到PT1-PT2直线的垂足PT4
        (setq PT4 (polar PT3 ANG 100)
              PT4 (inters PT1 PT2 PT3 PT4 NIL)
        )
        
        ;;; 计算边长1：PT1到PT2的距离
        (setq dist0 (distance PT1 PT2))
        
        ;;; 计算边长2：PT3到PT1-PT2直线的垂直距离
        (setq H (distance PT4 PT3))
        (setq dist2 H)
        
        ;;; 计算矩形的另外两个角点
        (setq PT02 (polar PT01 ANG0 dist0))
        (setq PT03 (polar PT02 (- (angle PT3 PT4) pi) dist2))
        (setq PT04 (polar PT01 (- (angle PT3 PT4) pi) dist2))
        
        ;;; 绘制矩形
        (command "_.pline"
                 "non" PT01
                 "non" PT02
                 "non" PT03
                 "non" PT04
                 "c"
        )
        (prompt "\n矩形绘制完毕！！")
        (command "_.regen")
      )
    )
  )
  (princ)
)
; 简化命令别名
(defun c:r3 () (c:rect3p))

网友答:
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:"是怎么回事？请指教一下，谢谢！

网友答: (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)
)

网友答:

给你一个动态的

(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)
)



网友答: 学习一下， 不错！


网友答:
  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))


网友答:

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

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

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

谢谢



网友答:

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



网友答:

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

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

恳请大侠帮忙,谢谢！



网友答:

(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)

  • 上一篇：谁有多重拉伸的LISP
  • 下一篇：没有了
    CAD技术交流中心 | 建筑CAD | 给排水CAD | 暖通CAD | 电气CAD | 电力CAD | 机械CAD | CAD母线槽 | CAD看图
    Copyright © 2019 - 2025