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

Lisp创建“矩形选择”

你好
 
我希望在lisp例程中包含autocad中存在的“矩形选择效果”。当你点击屏幕上的任何一个点，然后点击第二个点，这个效果就会出现。
 
类似这样的东西，但具有“矩形效果”而不是直线。
 

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

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


(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

决定进行日常练习：
(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

 
快一点
 

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

Grrr 发表于 2022-7-5 18:06:52

 
不错！
现在我看到我可能不得不使用X和Y值来找到pt2和pt3。不过，我的（inters）方法也可以作为一种替代方法。
此外，虽然我正在阅读帮助文件，但我不知道GRVEC可以这样工作。
...你的代码要短得多

Tharwat 发表于 2022-7-5 18:12:40

始终尝试为用户提供一个选项，以选择采用哪种方式或安全地取消程序，但在您的程序中，您强制用户按ESC按钮以结束程序。

Grrr 发表于 2022-7-5 18:17:35

 
是的，我知道。。这只是我的一个习惯（在我决定发布之前，我在ACAD中多次测试代码的行为）。。因为我懒得重新运行命令。

sadhu 发表于 2022-7-5 18:22:59

再次感谢Tharwat。非常有帮助。
页: [1] 2
查看完整版本: Lisp创建“矩形选择”