一个通过画圆生成正方形的代码

Lisphk · 发表于 2016-10-29 15:12:45

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun C:tt (/ d AcSpc p CircleObj p1 p3 ll ur)
  (initget (+ 1 2 4))
  (setq d (getreal "\n方形边长: "))
  (setq AcSpc (vlax-get-property (vla-get-ActiveDocument
                                                         (vlax-get-acad-object)
                                 ) (if (= 1 (getvar 'CVPORT))
                                     'Paperspace
                                     'Modelspace
                                   )
              )
  )
  (setvar 'errno 0)
  (while (/= 52 (getvar 'errno))
    (initget 128 "Size")
    (setq p (getpoint "\n方形中心点 or [Size]: "))
    (cond
      ((and
         (= 'STR (type p))
         (wcmatch p "S*")
       )
        (initget (+ 1 2 4))
        (setq d (getreal "\n输入方形边长: "))
      )
      ((and
         p
         (listp p)
       )
        (setq CircleObj (vla-AddCircle AcSpc (vlax-3D-point p) (/ d 2.)))
        (vla-GetBoundingBox CircleObj 'll 'ur)
        (mapcar
          'set
          '(p1 p3)
          (mapcar
            'vlax-safearray->list
            (list ll ur)
          )
        )
        (entmake (append
                   (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity")
                         (cons 100 "AcDbPolyline") (cons 90 4)
                         (cons 70 1)
                   )
                   (mapcar
                     '(lambda (x)
                        (cons 10 x)
                      )
                     (list p1 (list (car p1) (cadr p3)) p3 (list
                                                                 (car p3)
                                                                 (cadr p1)
                                                           )
                     )
                   )
                 )
        )
        (vla-Delete CircleObj)
      )
      (T
        (setvar 'errno 52)
      )
    )
  )
  (princ)
)

Lisphk · 发表于 2016-10-29 15:18:15

上面的代码相当于：

(defun c:tt (/ dia)
  (setq dia (getreal "\n输入边长... "))
  (setq dia (/ dia 2))
  (while (setq cen (getpoint "\n输入中心<退出>:"))
    (command "polygon" "4" cen "c" dia)
  )
  (princ)
)

longer1000 · 发表于 2016-10-29 16:53:08

啥也不说了，感谢楼主分享哇！

yoyoho · 发表于 2016-10-29 17:26:10

感谢 Lisphk 分享程序!

炫翔 · 发表于 2016-10-29 18:33:44

还是用点向量比较好

qing412808 · 发表于 2016-10-30 15:58:58

谢谢分享，谢谢分享，

whdong76 · 发表于 2016-10-31 08:06:13

啥也不说了，感谢楼主分享哇！

a88611462 · 发表于 2016-11-7 15:11:57

确实是难得好帖啊，顶先

yxianfo · 发表于 2016-11-9 17:00:30

本帖最后由 yxianfo 于 2016-11-9 17:01 编辑

谢谢分享，源码必须学习！

sicky111 · 发表于 2016-11-10 08:39:35

很实用，更喜欢第二个。

kqqt6236 · 发表于 2016-11-13 21:02:33

全部收下了，谢谢！

xvjiex · 发表于 2021-10-28 07:04:32

感谢分享一个通过画圆生成正方形的代码

yangjian001 · 发表于 2021-10-28 08:56:41

做一个热心并受欢迎的人

downhh · 发表于 2021-10-28 14:19:23

是画圆还是画方呢？。。。

账号		自动登录	找回密码
密码			立即注册

[每日一码] 一个通过画圆生成正方形的代码

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。