月下闲人 发表于 2024-12-30 22:16:49

求助怎么快速生成矩形的黄金分割线？

求助怎么快速生成矩形横向和纵向的黄金分割线？


xyp1964 发表于 2024-12-31 11:48:59

;; 实体黄金分割线


Bao_lai 发表于 2024-12-30 22:52:57

距离的(√5-1)/2

月下闲人 发表于 2024-12-31 19:35:29

xyp1964 发表于 2024-12-31 11:48
;; 实体黄金分割线

很好→很棒！很好~很棒！！

月下闲人 发表于 2025-1-1 23:41:15

xyp1964 发表于 2024-12-31 11:48
;; 实体黄金分割线

院长我找到你多年以前的代码
;;;黄金比 : hjb
(defun c:hjb ()
   (setqpt1 (getpoint "\n起点 :")
no6 (getreal "\n短边长 : ")
leng   (/ (- (sqrt 5) 1) 2);黄金比长边尺寸
pt2 (list (+ (car pt1) no6) (+ (cadr pt1) (* no6 leng)))
   )
   (command "rectang" pt1 pt2);黄金比的长方形
)

xyp1964 发表于 2025-1-2 13:08:08

月下闲人 发表于 2025-1-1 23:41
院长我找到你多年以前的代码
;;;黄金比 : hjb
(defun c:hjb ()


(defun c:tt ()
"黄金比矩形"
(setq dd (Udist 7 "" "短边长<输入或鼠标直接量取>" dd nil)
      sc (/ (- (sqrt 5) 1) 2.) ;黄金比
)
(while (setq p1 (getpoint "\n起点<退出>: "))
    (setq p2 (list (+ (car p1) dd) (+ (cadr p1) (* dd sc)))
          s1(command "rectang" "non" p1 "non" p2)
    )
)
(princ)
)

月下闲人 发表于 2025-1-2 20:46:56

xyp1964 发表于 2025-1-2 13:08


再次感谢很好用

月下闲人 发表于 2025-3-8 11:35:41

本帖最后由 月下闲人 于 2025-3-8 11:36 编辑

xyp1964 发表于 2024-12-31 11:48
;; 实体黄金分割线
院长好麻烦帮我看看哪里不对谢谢了

(defun c:HJJ (/ *acad* *doc* ss i ent obj result minPt maxPt width height hSplitY vSplitX)
(vl-load-com)
(setq *acad* (vlax-get-acad-object))
(setq *doc* (vla-get-activedocument *acad*))

;; 创建或获取黄金分割线图层
(if (not (tblsearch "LAYER" "HJX-黄金线"))
    (vla-add (vla-get-layers *doc*) "HJX-黄金线")
)
(vla-put-color (vla-item (vla-get-layers *doc*) "HJX-黄金线") 1)
(vla-put-linetype (vla-item (vla-get-layers *doc*) "HJX-黄金线") "Continuous")

;; 用户交互
(prompt "\n请选择对象: ")
(if (setq ss (ssget '((0 . "CIRCLE,ELLIPSE,LWPOLYLINE,POLYLINE,SPLINE,INSERT,HATCH"))))
    (progn
      (repeat (setq i (sslength ss))
      (setq ent (ssname ss (setq i (1- i)))
            obj (vlax-ename->vla-object ent))
      ;; 安全获取边界框
      (setq result (vl-catch-all-apply 'vla-getboundingbox (list obj 'minPt 'maxPt)))
      (if (vl-catch-all-error-p result))
          (princ "\n错误: 无法获取对象的边界框。")
          (progn
            ;; 转换坐标数据
            (setq minPt (vlax-safearray->list (vlax-variant-value minPt)))
            (setq maxPt (vlax-safearray->list (vlax-variant-value maxPt)))
            ;; 计算尺寸
            (setq width (- (car maxPt) (car minPt))
                  height (- (cadr maxPt) (cadr minPt)))
            )
            ;; 有效性检查
            (if (and (> width 1e-6) (> height 1e-6)); 避免浮点误差
            (progn
                ;; 计算黄金分割点
                (setq hSplitY (+ (cadr minPt) (* height 0.618))
                (setq vSplitX (+ (car minPt) (* width 0.618)))
                ;; 创建分割线
                (entmakex (list '(0 . "LINE")
                              '(8 . "HJX-黄金线")
                              (cons 10 (list (car minPt) hSplitY 0.0))
                              (cons 11 (list (car maxPt) hSplitY 0.0))
                )
                (entmakex (list '(0 . "LINE")
                              '(8 . "HJX-黄金线")
                              (cons 10 (list vSplitX (cadr minPt) 0.0))
                              (cons 11 (list vSplitX (cadr maxPt) 0.0))
                )
            )
            (princ "\n警告: 对象尺寸过小或无效，已跳过。")
            )
          )
      )
      )
    )
    (princ "\n未选择有效对象。"))
(princ)
)


xyp1964 发表于 2025-3-8 16:35:19

月下闲人 发表于 2025-3-8 11:35
院长好麻烦帮我看看哪里不对谢谢了

(defun c:HJJ (/ *acad* *doc* ss i ent obj result minPt max ...

(defun c:tt ()
(setq *doc* (vla-get-activedocument (vlax-get-acad-object)))
(vla-add (vla-get-layers *doc*) "HJX-黄金线")
(vla-put-color(vla-item (vla-get-layers *doc*)"HJX-黄金线")1)
(vla-put-linetype(vla-item (vla-get-layers *doc*)"HJX-黄金线")"Continuous")
(prompt "\n请选择对象: ")
(if (setq ss (ssget '((0 . "CIR*,ELL*,*LINE,INSERT,HATCH"))))
    (repeat (setq i (sslength ss))
      (setq ent (ssname ss (setq i (1- i)))
            obj (vlax-ename->vla-object ent)
      )
      (vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p9)
      (setq a(mapcar 'vlax-safearray->list (list p1 p9))
            p1 (car a)
            p9 (cadr a)
            yy (+ (cadr p1) (* (- (cadr p9) (cadr p1)) 0.618))
            xx (+ (car p1) (* (- (car p9) (car p1)) 0.618))
      )
      (entmakex (list '(0 . "LINE")
                      '(8 . "HJX-黄金线")
                      (cons 10 (list (car p1) yy))
                      (cons 11 (list (car p9) yy))
                )
      )
      (entmakex (list '(0 . "LINE")
                      '(8 . "HJX-黄金线")
                      (cons 10 (list xx (cadr p1)))
                      (cons 11 (list xx (cadr p9)))
                )
      )
    )
)
(princ)
)

月下闲人 发表于 2025-3-9 00:18:58

xyp1964 发表于 2025-3-8 16:35


简洁又强大非常棒感谢院长赐教
页: [1] 2
查看完整版本: 求助怎么快速生成矩形的黄金分割线？