社区 › Auto Lisp › 使用Perpen绘制矩形

avarte 发表于 2022-7-5 17:34:51

使用Perpen绘制矩形

大家好，
 
我对编写lisp很陌生，但我试图编写一个lisp，它可以帮助我使用2条多段线的垂直参考点绘制一个矩形。附件是我想如何画它的图片。仅使用onsnap很难绘制矩形。我想知道是否可以单击多段线的两个端点和另一个方向的多段线来绘制矩形。

Tharwat 发表于 2022-7-5 17:46:16

试试这个，让我知道：

(defun c:Test (/ s ss a b c d ins lst)
;;                 Tharwat - Date: 21.June.2016                ;;
;; Draw closed LWpolyline from the two selected        ;;
;; LWpolylines and they must be straight.                ;;
(defun _straight-p (e / l q a)
   (setq l (mapcar 'cdr
                   (vl-remove-if-not
                     '(lambda (p) (= (car p) 10))
                     (entget (ssname e 0))
                     )
                   )
         q (car l)
         a (angle q (cadr l))
         )
   (apply
   'and
   (mapcar
       '(lambda (pt) (and (equal (angle q pt) a 1e-4) (setq q pt)))
       (cdr l)
       )
   )
   )
(princ "\nSelect 1st LWpolyline :")
(if (and (setq s (ssget "_+.:S:E" '((0 . "LWPOLYLINE"))))
          (_straight-p s)
          (princ "\nSelect 2nd LWpolyline :")
          (setq ss (ssget "_+.:S:E" '((0 . "LWPOLYLINE"))))
          (_straight-p ss)
          (setq a (vlax-curve-getstartpoint (ssname s 0))
                b (vlax-curve-getendpoint (ssname s 0))
                c (vlax-curve-getstartpoint (ssname ss 0))
                d (vlax-curve-getendpoint (ssname ss 0))
                )
          (setq ins (inters a b c d))
          )
   (progn
   (mapcar '(lambda (j k)
                (setq lst (cons (list (polar a j k)
                                    (polar b j k)
                                    )
                              lst
                              )
                      )
                )
             (list (angle d c) (angle c d))
             (list (distance ins c) (distance ins d))
             )
   (setq lst (apply 'append lst))
   (entmake (list '(0 . "LWPOLYLINE")
                  '(100 . "AcDbEntity")
                  '(100 . "AcDbPolyline")
                  '(90 . 4)
                  '(70 . 1)
                  (cons 10 (car lst))
                  (cons 10 (caddr lst))
                  (cons 10 (last lst))
                  (cons 10 (cadr lst))
                  )
            )
   )
   (princ "\nLWpolylines must be straight and crossed !")
   )
(princ)
)(vl-load-com)

Lee Mac 发表于 2022-7-5 17:55:25

下面是另一种书写方式：
(defun c:myrect ( / int pl1 pl2 pt1 pt2 pt3 pt4 )
   (if (and (setq pl1 (ssget "_+.:E:S" '((0 . "LWPOLYLINE") (90 . 2))))
            (setq pl2 (ssget "_+.:E:S" '((0 . "LWPOLYLINE") (90 . 2))))
       )
       (if (setq pl1 (entget (ssname pl1 0))
               pl2 (entget (ssname pl2 0))
               pt1 (cdr (assoc 10 pl1))
               pt2 (cdr (assoc 10 (reverse pl1)))
               pt3 (cdr (assoc 10 pl2))
               pt4 (cdr (assoc 10 (reverse pl2)))
               int (inters pt1 pt2 pt3 pt4)
         )
         (entmake
               (list
                  '(000 . "LWPOLYLINE")
                  '(100 . "AcDbEntity")
                  '(100 . "AcDbPolyline")
                  '(090 . 4)
                  '(070 . 1)
                   (cons 10 (mapcar '+ pt1 (mapcar '- pt3 int)))
                   (cons 10 (mapcar '+ pt1 (mapcar '- pt4 int)))
                   (cons 10 (mapcar '+ pt2 (mapcar '- pt4 int)))
                   (cons 10 (mapcar '+ pt2 (mapcar '- pt3 int)))
               )
         )
         (princ "\nLines do not intersect.")
       )
   )
   (princ)
)

Tharwat 发表于 2022-7-5 18:04:52

当所有坐标都在同一条线上时，我的工作是在一条多段线的多个顶点上进行。

pkenewell 发表于 2022-7-5 18:17:44

为了扩展李的优秀作品，我想做一个更通用的版本，允许选择任何类型的线段，并创建矩形。因此，使用李的“SelectIf”和我从Stig Madsen的theSwamp中获得的另一段代码：
 
 
请随意撕下它，使其更高效，但我认为这可能对应用程序更通用。

Grrr 发表于 2022-7-5 18:22:45

干得好，普肯维尔！
我通常使用Stefan\u BMR中名为“get\u ends”的子函数来选取直线/普林线的段，但现在我将分析您发布的代码。

pkenewell 发表于 2022-7-5 18:27:28

编辑了我上面的程序，只过滤直线和多段线，因为样条曲线、多段线和连接线会引起问题。

avarte 发表于 2022-7-5 18:41:40

非常感谢你们。没想到我会这么快得到回复。非常感谢你。我明白为什么我以前的代码不起作用了。从你们身上学到了很多。再次感谢你。

查看完整版本: 使用Perpen绘制矩形