通过LINE连接两个块

marting · 发表于 2017-5-21 10:22:05

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

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

×

本帖最后由 marting 于 2017-5-21 12:36 编辑

程序里面演示了动态根据鼠标和块的相对位置确定连线的方向

(defun c:Test (/ s p ss q 1p gr)
(princ "\nPick on the first Block :")
(if (setq s (ssget "_+.:S:E" '((0 . "INSERT"))))
(progn
(princ "\nNext Block :")
(while (setq ss (ssget "_+.:S:E" '((0 . "INSERT"))))
(setq p (cdr (assoc 10 (entget (ssname s 0)))))
(while (and s ss (eq 5 (car (setq gr (grread t 15 0)))))
(redraw)
(setq q (cdr (assoc 10 (entget (ssname ss 0)))))
(if (or (equal (car p) (car q) 1e-4)
(equal (cadr p) (cadr q) 1e-4)
)
(grvecs (list -3 p q))
(if
(minusp
(sin
(-
(angle
p
q
)
(angle q (cadr gr))
)
)
)
(grvecs
(list -3 p (setq 1p (list (car q) (cadr p) 0.)) 1p q)
)
(grvecs
(list -3 p (setq 1p (list (car p) (cadr q) 0.)) 1p q)
)
)
)
)
(if (eq (car gr) 3)
(if (and p 1p q)
(mapcar
'(lambda (j k)
(entmake (list '(0 . "LINE") (cons 10 j) (cons 11 k)))
)
(list p 1p)
(list 1p q)
)
(if (not (zerop (distance p q)))
(entmake (list '(0 . "LINE") (cons 10 p) (cons 11 q)))
)
)
)
(redraw)
(setq 1p nil
s ss
)
)
)
)
(princ)
)

(defun c:Test (/ s p ss q 1p gr) 
  (princ "\nPick on the first Block :") 
  (if (setq s (ssget "_+.:S:E" '((0 . "INSERT")))) 
    (progn 
      (princ "\nNext Block :") 
      (while (setq ss (ssget "_+.:S:E" '((0 . "INSERT")))) 
        (setq p (cdr (assoc 10 (entget (ssname s 0))))) 
        (while (and s ss (eq 5 (car (setq gr (grread t 15 0))))) 
          (redraw) 
          (setq q (cdr (assoc 10 (entget (ssname ss 0))))) 
          (if (or (equal (car p) (car q) 1e-4) 
                  (equal (cadr p) (cadr q) 1e-4) 
                  ) 
            (grvecs (list -3 p q)) 
            (if 
              (minusp 
                (sin 
                  (- 
                    (angle 
                      p 
                      q 
                      ) 
                    (angle q (cadr gr)) 
                    ) 
                  ) 
                ) 
               (grvecs 
                 (list -3 p (setq 1p (list (car q) (cadr p) 0.)) 1p q) 
                 ) 
               (grvecs 
                 (list -3 p (setq 1p (list (car p) (cadr q) 0.)) 1p q) 
                 ) 
               ) 
            ) 
          ) 
        (if (eq (car gr) 3) 
          (if (and p 1p q) 
            (mapcar 
              '(lambda (j k) 
                 (entmake (list '(0 . "LINE") (cons 10 j) (cons 11 k))) 
                 ) 
              (list p 1p) 
              (list 1p q) 
              ) 
            (if (not (zerop (distance p q))) 
              (entmake (list '(0 . "LINE") (cons 10 p) (cons 11 q))) 
              ) 
            ) 
          ) 
        (redraw) 
        (setq 1p nil 
              s  ss 
              ) 
        ) 
      ) 
    ) 
  (princ) 
  )

另外一个代码：

游客，如果您要查看本帖隐藏内容请回复

ynhh · 发表于 2017-5-21 12:32:16

感谢你的分享
你太牛了

HLCAD · 发表于 2017-5-21 12:52:51

感谢大师分享程序！

sh_h · 发表于 2017-5-21 12:57:21

跟着大师好好学习，天天向上！

434939575 · 发表于 2017-5-21 13:22:34

谢谢分享！是停不下来的感觉！！

Linhay · 发表于 2017-5-22 06:57:21

跟着大师好好学习，天天向上！

liunian0524 · 发表于 2017-5-22 08:07:07

感谢楼主分享

zixuan203344 · 发表于 2017-6-16 19:11:14

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

yoyoho · 发表于 2017-6-17 15:18:13

感谢分享程序

xinxirong · 发表于 2017-6-17 15:38:43

谢谢分享！是停不下来的感觉！

杜流浪人 · 发表于 2017-6-17 20:42:25

出杰作啊

laiz3000 · 发表于 2017-6-17 22:12:21

跟大师学习

a871352 · 发表于 2017-6-18 00:36:39

謝謝大師學習...學習了

ysx810210 · 发表于 2017-6-18 22:58:14

学习下.................

zy412452785 · 发表于 2017-11-10 11:15:49

謝謝大師學習...學習了

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

[每日一码] 通过LINE连接两个块

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