prodromosm 发表于 2022-7-6 00:02:18

矩形lisp。帮个小忙！

你好我在一篇旧帖子中发现了这个Lisp程序
(defun c:BX (/ foo _dist p1 p2 p3 ang)
;; Draw rectangle based on 2 or 3 picked points
;; Alan J. Thompson, 07.26.10

(defun foo (l)
   (entmake
   (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (90 . 4) (70 . 129))
             (mapcar (function (lambda (p) (cons 10 (reverse (cdr (reverse (trans p 1 0))))))) l)
   )
   )
)

(defun _dist (a b) (distance (list (car a) (cadr a)) (list (car b) (cadr b))))

(if (and (setq p1 (getpoint "\nSpecify first point: "))
          (setq p2 (getpoint p1 "\nSpecify second point: "))
          (not (grdraw p1 p2 3 1))
   )
   (if (setq p3 (initget 0 "Left Right")
             p3 (getpoint p2 "\nSpecify third point or Square box or : ")
       )
   (cond ((vl-consp p3) (foo (list p1 p2 p3 (polar p3 (angle p2 p1) (_dist p1 p2)))))
         ((eq (type p3) 'STR)
            (cond
            ((eq p3 "Left") (setq ang (+ (/ pi 2.) (angle p1 p2))))
            ((eq p3 "Right") (setq ang (+ (* pi 1.5) (angle p1 p2))))
            )
            (foo (list p1 p2 (polar p2 ang (_dist p1 p2)) (polar p1 ang (_dist p1 p2))))
         )
   )
   )
)
(redraw)
(princ)
)
 
我需要再添加一个命令
我需要像照片一样用3个点做成矩形

ReMark 发表于 2022-7-6 00:07:03

为什么？阿兰的三点矩形需要三角挑吗？

prodromosm 发表于 2022-7-6 00:10:10

不像这张照片

marko_ribar 发表于 2022-7-6 00:14:01

这适用于2012年。。。
 

(defun c:RX (/ p1 p2 p3 l1 l2 l3 l4 pea)
(setq p1 (getpoint "\nPick first point: ") p1 (trans p1 1 0))
(setq p2 (getpoint (trans p1 0 1) "\nPick second point: ") p2 (trans p2 1 0))
(setq p3 (getpoint "\nPick third point: "))
(setq l1 (entmakex (list '(0 . "LINE") (cons 10 p1) (cons 11 p2))))
(command "_.offset" "t" l1 p3 "")
(setq l2 (entlast))
(setq l3 (entmakex (list '(0 . "LINE") (cons 10 p1) (cons 11 (cdr (assoc 10 (entget l2)))))))
(setq l4 (entmakex (list '(0 . "LINE") (cons 10 p2) (cons 11 (cdr (assoc 11 (entget l2)))))))
(setq pea (getvar 'peditaccept))
(setvar 'peditaccept 1)
(command "_.pedit" l1 "j" l1 l2 l3 l4 "" "")
(setvar 'peditaccept pea)
(princ)
)

 
M、 R。

prodromosm 发表于 2022-7-6 00:15:24

谢谢marko_ribar干得好

MSasu 发表于 2022-7-6 00:20:16

很好的解决方案Marko！简单但有效。
 
我将为第三个点位于前两个点定义的线上的情况添加保护。

David Bethel 发表于 2022-7-6 00:22:12

只是拼凑在一起
 

(defun c:test (/ p1 p2 p3 p4 p5 p6)
(initget 1)
(setq p1 (getpoint "\nPoint 1:   ")))

(initget 1)
(setq p2 (getpoint p1 "\n2nd Point:   "))

(initget 1)
(setq p3 (getpoint p2 "\Opposing edge Point:   "))

(if (setq p4 (inters p1 p2 p3 (polar p3 (+ (angle p1 p2) (* pi 0.5)) 1) nil))
   (setq p5 (polar p1 (+ (angle p1 p2) (* pi 0.5)) (distance p1 p4))
         p6 (polar p2 (+ (angle p1 p2) (* pi 0.5)) (distance p1 p4)))
          
(and p1 p2 p5 p6
(entmake (list (cons 0 "LINE")(cons 10 p1)(cons 11 p2)))          
(entmake (list (cons 0 "LINE")(cons 10 p1)(cons 11 p5)))          
(entmake (list (cons 0 "LINE")(cons 10 p2)(cons 11 p6)))          
(entmake (list (cons 0 "LINE")(cons 10 p5)(cons 11 p6)))          

(prin1))       
 
 
需要进行一些3D点错误检查。
-大卫

GP_ 发表于 2022-7-6 00:27:06

David，我修改了p5和p6
 

(defun c:test (/ p1 p2 p3 p4 p5 p6)
(initget 1)
(setq p1 (getpoint "\nPoint 1:   "))
(initget 1)
(setq p2 (getpoint p1 "\n2nd Point:   "))
(initget 1)
(setq p3 (getpoint p2 "\Opposing edge Point:   "))
(if (setq p4 (inters p1 p2 p3 (polar p3 (+ (angle p1 p2) (* pi 0.5)) 1) nil))
      (setq p5 (polar p1 (angle p4 p3) (distance p4 p3))
            p6 (polar p2 (angle p4 p3) (distance p4 p3))
      )
)

(and p1 p2 p5 p6
       (entmake
         (list
               (cons 0 "LWPOLYLINE")
               (cons 100 "AcDbEntity")
               (cons 100 "AcDbPolyline")
               (cons 90 4)
               (cons 70 1)
               (cons 10 p1)
               (cons 10 p2)
               (cons 10 p6)
               (cons 10 p5)
         )
       )
   )
   (princ)
)

MSasu 发表于 2022-7-6 00:28:17

这应该是由于Marco使用了该版本不支持的Peitaccept系统变量；例程在该点上崩溃，因此无法实现多段线构建。

David Bethel 发表于 2022-7-6 00:31:32

 
他们需要这样！
页: [1] 2
查看完整版本: 矩形lisp。帮个小忙！