Lisp创建“矩形选择”

sadhu · 发表于 2022-7-5 17:26:45

你好

我希望在lisp例程中包含autocad中存在的“矩形选择效果”。当你点击屏幕上的任何一个点，然后点击第二个点，这个效果就会出现。

类似这样的东西，但具有“矩形效果”而不是直线。


(setq pt1 (getpoint "Select point 1... "))
(setq pt2 (getpoint pt1 "Opposite corner... "))

Tharwat · 发表于 2022-7-5 17:33:57

copy


(setq pt2 (getcorner pt1 "\nOpposite corner... "))

sadhu · 发表于 2022-7-5 17:44:05

谢谢塔瓦。

就这么简单。

Tharwat · 发表于 2022-7-5 17:49:31

是啊

不客气。

Grrr · 发表于 2022-7-5 17:56:18

决定进行日常练习：

copy

(defun C:test ( / oldclp pt1 LoopFlag UserIn TypeUserIn ReturnChar vsz SS SSn in1 in2 )
(sssetfirst nil nil)
(while T
        (if (setq pt1 (getpoint "\nSpecify first point" ))
                (progn
                        (setq oldclp (getvar 'clipromptlines))
                        (setvar 'clipromptlines 1)
                        (redraw)
                        (princ "\nSpecify second point: ")
                        (setq LoopFlag T)
                        (while LoopFlag
                                (setq UserIn (grread T))
                                (setq TypeUserIn (car UserIn))
                                (setq ReturnChar (cadr UserIn))
                                (cond
                                        ((= TypeUserIn 5) ; cursor is moved
                                                (princ "\nSpecify second point: ")
                                                (setq vsz (* (getvar 'viewsize) 10))
                                                (or
                                                        (setq in1 (inters pt1 (polar pt1 (angtof "90") vsz) ReturnChar (polar ReturnChar (angtof "0") vsz)))
                                                        (setq in1 (inters pt1 (polar pt1 (angtof "90") vsz) ReturnChar (polar ReturnChar (angtof "180") vsz)))
                                                        (setq in1 (inters pt1 (polar pt1 (angtof "270") vsz) ReturnChar (polar ReturnChar (angtof "0") vsz)))
                                                        (setq in1 (inters pt1 (polar pt1 (angtof "270") vsz) ReturnChar (polar ReturnChar (angtof "180") vsz)))
                                                )
                                                (or
                                                        (setq in2 (inters pt1 (polar pt1 (angtof "0") vsz) ReturnChar (polar ReturnChar (angtof "90") vsz)))
                                                        (setq in2 (inters pt1 (polar pt1 (angtof "0") vsz) ReturnChar (polar ReturnChar (angtof "270") vsz)))
                                                        (setq in2 (inters pt1 (polar pt1 (angtof "180") vsz) ReturnChar (polar ReturnChar (angtof "90") vsz)))
                                                        (setq in2 (inters pt1 (polar pt1 (angtof "180") vsz) ReturnChar (polar ReturnChar (angtof "270") vsz)))
                                                )
                                                (if (and pt1 in1 in2 ReturnChar)
                                                        (progn
                                                                (redraw)
                                                                (grvecs
                                                                        (list
                                                                                1 pt1 in1
                                                                                1 pt1 in2
                                                                                1 ReturnChar in1
                                                                                1 ReturnChar in2
                                                                        )
                                                                )
                                                        )
                                                        (redraw)
                                                )
                                        )
                                        ((= TypeUserIn 3) ; LMB is pressed
                                                (if oldclp (setvar 'clipromptlines oldclp))
                                                (setq LoopFlag nil)
                                                (if SS (progn (setq SSn SS) (sssetfirst nil nil)))
                                                (if (setq SS (ssget "_CP" (list pt1 in1 ReturnChar in2)))
                                                        (progn
                                                                (setq SS (acet-ss-union (list SSn SS))) ; requires express tools!
                                                                (sssetfirst nil SS)
                                                        )
                                                        (setq SS nil)
                                                )
                                        )
                                        (T nil)
                                );cond                        
                        );while LoopFlag
                )
        )
)
(princ)
)

这是基于我从塔瓦特、李·麦克、卡布那里学到的。。。

Tharwat · 发表于 2022-7-5 17:57:39

快一点

copy


(defun c:sel (/ p1 gr p2 p3)
 ;; Tharwat - Emulate cursor selection set        ;;
 (if (setq p1 (getpoint "\n First point :"))
   (while
     (eq (car (setq gr (grread t 15 0))) 5)
      (redraw)
      (grvecs (list -3 p1 (setq p2 (list (car (cadr gr)) (cadr p1) 0.)) p2 (cadr gr)
                           (cadr gr)  (setq p3 (list (car p1) (cadr (cadr gr)) 0.))
                           p3
                           p1
              )
      )
   )
 )
 (redraw)
 (princ)
)