cq4920 发表于 2020-3-30 21:04:11

没啥用！

本帖最后由 cq4920 于 2020-6-22 16:22 编辑



感觉没啥用！但修改一下 也许能用上！直接删除有点可惜！需要的自己下载修改吧！
有啥疑问，就不要问我了自行查询吧！

lee50310 发表于 2020-4-2 13:13:21

本帖最后由 lee50310 于 2020-4-4 21:50 编辑

換成這個 ，是否感覺效果不一樣?如圖
;;
(defun c:grd ( / massoclst pol1 pol2 bl lst1 lst2 lil p gr pp v lst2n )

(defun massoclst ( key lst )
    (if (assoc key lst) (cons (assoc key lst) (massoclst key (cdr (member (assoc key lst) lst)))))
)

(setq pol1 (car (entsel "\n选择LWPOLYLINE ...")))
(setq pol2 (entmakex (vl-remove-if (function (lambda ( x ) (vl-position (car x) '(-1 5 330)))) (entget pol1))))
(setq bl (massoclst 42 (entget pol2)))
(setq lst1 (mapcar 'cdr (massoclst 10 (entget pol1))))
(setq lst2 (mapcar 'cdr (massoclst 10 (entget pol2))))
(mapcar (function (lambda ( a b ) (setq lil (cons (entmakex (list '(0 . "LINE") (cons 10 a) (cons 11 b))) lil)))) lst1 lst2)
(setq lil (reverse lil))
(setq p (getpoint "\n选择指定点 "))
(prompt "\n移动鼠标并按 \"+\" or \"-\" 比例放大縮小键和 \"4\" or \"6\" 旋转...完成鼠标左键单击...")
(while (/= 3 (car (setq gr (grread t))))
    (cond
      ( (and (= 2 (car gr)) (= 43 (cadr gr)))
      (setq lst2n (mapcar (function (lambda ( x ) (mapcar '+ pp (mapcar '* (mapcar '- x pp) (list (sqrt 2.0) (sqrt 2.0)))))) lst2n))
      )
      ( (and (= 2 (car gr)) (= 45 (cadr gr)))
      (setq lst2n (mapcar (function (lambda ( x ) (mapcar '+ pp (mapcar '* (mapcar '- x pp) (list (/ (sqrt 2.0) 2.0) (/ (sqrt 2.0) 2.0)))))) lst2n))
      )
      ( (and (= 2 (car gr)) (= 52 (cadr gr)))
      (setq lst2n (mapcar (function (lambda ( x ) (polar pp (+ (angle pp x) (/ pi 4.0)) (distance pp x)))) lst2n))
      )
      ( (and (= 2 (car gr)) (= 54 (cadr gr)))
      (setq lst2n (mapcar (function (lambda ( x ) (polar pp (- (angle pp x) (/ pi 4.0)) (distance pp x)))) lst2n))
      )
      ( t
      (if (null pp)
          (setq pp (cadr gr))
      )
      (setq v (mapcar '- pp p))
      (if (null lst2n)
          (setq lst2n (mapcar (function (lambda ( x ) (mapcar '+ v x))) lst2))
          (progn
            (setq lst2n (mapcar (function (lambda ( x ) (mapcar '+ (mapcar '- (cadr gr) pp) x))) lst2n))
            (setq pp (cadr gr))
          )
      )
      )
    )
    (entmod (append (vl-remove-if (function (lambda ( x ) (vl-position (car x) '(10 42)))) (entget pol2)) (apply 'append (mapcar (function (lambda ( a b ) (list (cons 10 a) b))) lst2n bl))))
    (mapcar (function (lambda ( a x ) (entmod (subst (cons 11 a) (assoc 11 (entget x)) (entget x))))) lst2n lil)
    (redraw)
)
(princ)
)

lee50310 发表于 2020-4-2 17:43:20

pengfei2010 发表于 2020-4-2 14:13
你这个平面生成立面是根据什么规则生成的呀，我看了好几遍都没有看明白！

使用 grread函数 去抓滑鼠及鍵盤
這裡有介紹:
http://bbs.mjtd.com/thread-91191-1-1.html

cq4920 发表于 2020-3-30 23:08:37

墨雨尘峰 发表于 2020-3-30 22:48
好东西啊，但是我这边有 错误: no function definition: XJTC

删除（xjtc）再把需要的图层名都改成你用的图层或者都改成 0 层

墨雨尘峰 发表于 2020-3-30 22:48:28

好东西啊，但是我这边有 错误: no function definition: XJTC

zjlai521 发表于 2020-3-31 08:42:55

东西不错 可惜权限不够

QQ873240166 发表于 2020-3-31 15:37:21

还不可以看再回帖

hhh454 发表于 2020-4-1 08:52:51

画装饰施工图可以用到，

pengfei2010 发表于 2020-4-2 14:13:31

你这个平面生成立面是根据什么规则生成的呀，我看了好几遍都没有看明白！

pengfei2010 发表于 2020-4-3 09:02:14

lee50310 发表于 2020-4-2 17:43
使用 grread函数 去抓滑鼠及鍵盤
這裡有介紹:
http://bbs.mjtd.com/thread-91191-1-1.html

不知道有啥用处
页: [1] 2
查看完整版本: 没啥用！