社区 › AutoLISP/Visual LISP 编程技术 › 请教高手帮忙修改以下的等分功能

＿Levin 发表于 2021-5-26 12:55:18

请教高手帮忙修改以下的等分功能

本帖最后由 ＿Levin 于 2021-5-26 12:58 编辑


上传了gif图片不知道能不能看到
情况是这样子的，输入命令后，第一点能捕捉，第二点没有捕捉，希望高手帮修改添加第二点有捕捉，还有这里的+-想换成 a s 顺手一些，感谢~


defun c:dfx ( / *error* g1 g2 gr h l ms p p1 p2 v )
;; Lee Mac 2011
(defun *error* ( m ) (redraw) (princ))
(or *n (setq *n 3))

(if (setq p1 (getpoint "\nSpecify First Corner: "))
    (progn
      (setq ms (princ "\nSpecify Opposite Corner : "))
      (while
      (progn (setq gr (grread t 15 0) g1 (car gr) g2 (cadr gr))
          (cond
            ( (= 5 g1)(redraw)
            (if *v
                (progn
                  (setq h (/ (- (car g2) (car p1)) (1+ *n))
                        v (- (cadr g2) (cadr p1))
                        p p1
                  )
                  (repeat *n
                  (setq p (list (+ h (car p)) (cadr p) (caddr p)))
                  (grdraw p (list (car p) (+ v (cadr p)) (caddr p)) -1)
                  )
                  (setq l
                  (list
                      p1 (list (car p1) (+ v (cadr p1)) (caddr p1))
                      g2 (list (+ h (car p)) (cadr p) (caddr p))
                  )
                  )
                )
                (progn
                  (setq h (- (car g2) (car p1))
                        v (/ (- (cadr g2) (cadr p1)) (1+ *n))
                        p p1
                  )
                  (repeat *n
                  (setq p (list (car p) (+ v (cadr p)) (caddr p)))
                  (grdraw p (list (+ (car p) h) (cadr p) (caddr p)) -1)
                  )
                  (setq l
                  (list
                      p1 (list (+ (car p1) h) (cadr p1) (caddr p1))
                      g2 (list (car p) (+ v (cadr p)) (caddr p))
                  )
                  )
                )
            )                  
            (mapcar '(lambda ( a b ) (grdraw a b 1 -1)) l (append (cdr l) (list (car l))))
            )
            ( (= 2 g1)
            (cond
                ( (member g2 '(45 95))
                  (if (= 1 *n)
                  (princ (strcat "\n--> Minimum Number of Lines Reached." ms))
                  (setq *n (1- *n))
                  )
                )
                ( (member g2 '(43 61))
                  (setq *n (1+ *n))
                )
                ( (= 9 g2)
                  (setq *v (not *v)) t
                )
            )
            )
            ( (= 3 g1)
            (if *v
                (progn
                  (setq h (/ (- (car g2) (car p1)) (1+ *n))
                        v (- (cadr g2) (cadr p1))
                  )
                  (repeat *n (setq p1 (list (+ h (car p1)) (cadr p1) (caddr p1)))
                  (entmakex
                      (list
                        (cons 0 "LINE")
                        (cons 10 (trans p1 1 0))
                        (cons 11 (trans (list (car p1) (+ v (cadr p1)) (caddr p1)) 1 0))
                      )
                  )
                  )
                )
                (progn
                  (setq h (- (car g2) (car p1))
                        v (/ (- (cadr g2) (cadr p1)) (1+ *n))
                  )
                  (repeat *n (setq p1 (list (car p1) (+ v (cadr p1)) (caddr p1)))
                  (entmakex
                      (list
                        (cons 0 "LINE")
                        (cons 10 (trans p1 1 0))
                        (cons 11 (trans (list (+ (car p1) h) (cadr p1) (caddr p1)) 1 0))
                      )
                  )
                  )
                )
            )
            nil
            )
          )
      )
      )
    )
)
(redraw) (princ)
)

lee50310 发表于 2021-6-15 19:53:42

可設 指定 行數 及 列數

lee50310 发表于 2021-6-16 14:01:01

本帖最后由 lee50310 于 2021-6-17 01:08 编辑

楼上的只能做正交等分，做不了楼上演示的效果
把列數設1 , 行數設4就跟樓主的動畫一樣

叮咚 发表于 2021-5-29 09:38:38

这些花里胡哨的你完全可以去掉。
用最简单的方法获取第二点，
做动态的话，可以在加减格子上体现。

烟盒迷唇 发表于 2021-5-27 11:09:23

换成带捕捉的GRREAD函数啊

＿Levin 发表于 2021-5-28 23:45:47

烟盒迷唇 发表于 2021-5-27 11:09
换成带捕捉的GRREAD函数啊

我写不来，请教下要怎么写？:(

lee50310 发表于 2021-5-29 20:23:28

本帖最后由 lee50310 于 2021-5-29 21:40 编辑

可上網找 Lee Mac 所寫的類似程式

＿Levin 发表于 2021-6-12 11:25:11

lee50310 发表于 2021-5-29 20:23
可上網找 Lee Mac 所寫的類似程式

这个不够方便啊，不能切换份数

bai2000 发表于 2021-6-15 21:30:15

楼上的只能做正交等分，做不了楼上演示的效果，能加个选项平行底边更好

zmzk 发表于 2022-4-15 21:02:55

太高深，功力不够啊

查看完整版本: 请教高手帮忙修改以下的等分功能