社区 › Auto Lisp › 生成多边形LISP

Lee Mac 发表于 2022-7-6 14:30:59

生成多边形LISP

只是胡闹，以为你们会喜欢这个-
 
将动态生成任意正多边形，使用TAB、+和-。
 

;; Make Polygon by Lee McDonnell (Lee Mac)
;; 29.05.2009

(defun c:mkPly (/ flag doc spc clr pt gr cPt
               Ang cAng cDis ptLst var)
(vl-load-com)

(setq doc (vla-get-ActiveDocument
             (vlax-get-Acad-Object))
       spc (if (zerop
               (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true) ; Vport
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc))
       clr 0)

(or *mkPly:Side* (setq *mkPly:Side* 4))
(if (setq pt (getpoint "\nSelect Centre Point: "))
   (progn
   (while
       (or
         (and
         (setq gr (grread t 7 0)) (eq 5 (car gr)))
         (and
         (eq 2 (car gr))
             (member
               (cadr gr)
               '(9 43 61 45))))
       (redraw)
       (if
         (and
         (eq 2 (car gr))
         (or
             (eq 43 (cadr gr)) ; +
             (eq 61 (cadr gr)))) ; = (as +)
         (setq *mkPly:Side* (+ *mkPly:Side* (if flag 2 1))
               clr (1+ clr)))
       (if
         (and
         (eq 2 (car gr))
         (eq 45 (cadr gr))) ; -
         (progn
         (and (< (if flag 6 3) *mkPly:Side*)
                (setq *mkPly:Side*
                  (- *mkPly:Side* (if flag 2 1))))
         (if (zerop clr)
             (setq clr 5)
             (setq clr (1- clr)))))
       (if
         (and
         (eq 2 (car gr))
         (eq 9 (cadr gr))) ; Tab
         (progn
         (setq flag (not flag))
         (if flag
             (setq *mkPly:Side* 6))))
       (if (eq 5 (car gr))
         (progn
         (setq cPt (cadr gr)
               Ang (/ (* 2. pi) *mkPly:Side*)
               cAng (angle pt cPt)
               cDis (distance pt cPt)
               ptLst (list cPt (polar pt (+ cAng Ang)
                                        (if (and flag (< 5 *mkPly:Side*)
                                                 (zerop (rem *mkPly:Side* 2)))
                                          (/ cDis 3.) cDis))) i 2.)
         (repeat (- *mkPly:Side* 2)
             (setq ptlst
               (append ptlst
               (list (last ptlst)
                   (polar pt (+ cAng (* i Ang))
                        (if (and flag (< 5 *mkPly:Side*)
                                 (zerop (rem *mkPly:Side* 2))
                                 (not (zerop (rem i 2))))
                            (/ cDis 3.) cDis)))) i (1+ i)))))
       (grvecs
         (setq ptlst
         (append
             (list (* -1 (1+ (rem clr 6))))
               ptlst (list (last ptlst) cPt)))))
   (if
       (and
         (eq 3 (car gr))
         (listp (cadr gr)))
       (progn
         (setq ptlst (apply
                     'append
                        (mapcar
                            (function
                              (lambda (x)
                              (list (car x) (cadr x))))
                            (append
                              (unique (cdr ptlst))
                              (list (cadr ptlst))))))
         (setq var
         (vlax-make-variant
             (vlax-safearray-fill
               (vlax-make-safearray
               vlax-vbdouble
                   (cons 0 (1- (length ptlst))))
               ptlst)))         
         (vla-addLightWeightPolyline spc var)))
   (redraw)))
(princ))

;; CAB
(defun unique (lst / result)
(reverse
   (while (setq itm (car lst))
   (setq lst (vl-remove itm lst)
         result (cons itm result)))))

Freerefill 发表于 2022-7-6 14:40:15

不错，我喜欢你如何选择大小和旋转。但是，这不是与AutoCAD命令“Polygon”惊人地相似吗？

Commandobill 发表于 2022-7-6 14:44:36

它绝对是整洁的。我很惊讶你对grread的奇怪痴迷更不喜欢它。英雄联盟

Freerefill 发表于 2022-7-6 14:50:55

我确实喜欢它。很难完全理解李的Lisp程序，因为大多数时候我都听不懂。o、 o'
 
然而，我确实注意到了什么可能是bug。当使用“星形”选项时，您可以切换回“多边形”选项并保持相同的边数，但当您使用“多边形”选项并切换到“星形”选项时，它似乎会恢复为一个三边星形。如果你向后拉，它会变成一个6边多边形。如果你减去一条边，它就会变成一个正方形。
 
尽管如此，它还是很好。我喜欢颜色和向量的使用。

Lee Mac 发表于 2022-7-6 14:59:49

 
是的，但可能更快
 
 
是的，星星需要偶数条边（最少6条），所以当你点击标签时，我把它设置为6条。但是我没有花太长时间写这篇文章，所以我想可以使用低于当前边数的偶数或类似的数字。
 
 
但是谢谢大家的评论

flowerrobot 发表于 2022-7-6 15:02:51

李，
 
你能告诉我你是如何创建幻影对象的吗？
 
 
非常感谢
 
花

Lee Mac 发表于 2022-7-6 15:08:32

 
GRVECS或GRDRAW函数将在屏幕上绘制“幻影”对象-GRVECS函数的负颜色值将指示高亮显示（虚线）。
 
李

sachindkini 发表于 2022-7-6 15:17:07

Lisp程序，先生

Lee Mac 发表于 2022-7-6 15:24:32

 
--谢谢--

MarcoW 发表于 2022-7-6 15:28:38

嗨，李，我没有用，但这是一个很好的惯例！
标签+的东西给了漂亮的星星。。。获得圣诞节的感觉。。。

查看完整版本: 生成多边形LISP