明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2067|回复: 16

[源码] 没啥用!

[复制链接]
发表于 2020-3-30 21:04 | 显示全部楼层 |阅读模式
本帖最后由 cq4920 于 2020-6-22 16:22 编辑



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

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2020-4-2 13:13 | 显示全部楼层
本帖最后由 lee50310 于 2020-4-4 21:50 编辑

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

  3.   (defun massoclst ( key lst )
  4.     (if (assoc key lst) (cons (assoc key lst) (massoclst key (cdr (member (assoc key lst) lst)))))
  5.   )

  6.   (setq pol1 (car (entsel "\n选择LWPOLYLINE ...")))
  7.   (setq pol2 (entmakex (vl-remove-if (function (lambda ( x ) (vl-position (car x) '(-1 5 330)))) (entget pol1))))
  8.   (setq bl (massoclst 42 (entget pol2)))
  9.   (setq lst1 (mapcar 'cdr (massoclst 10 (entget pol1))))
  10.   (setq lst2 (mapcar 'cdr (massoclst 10 (entget pol2))))
  11.   (mapcar (function (lambda ( a b ) (setq lil (cons (entmakex (list '(0 . "LINE") (cons 10 a) (cons 11 b))) lil)))) lst1 lst2)
  12.   (setq lil (reverse lil))
  13.   (setq p (getpoint "\n选择指定点 "))
  14.   (prompt "\n移动鼠标并按 \"+\" or \"-\" 比例放大縮小键和 \"4\" or \"6\" 旋转...完成鼠标左键单击...")
  15.   (while (/= 3 (car (setq gr (grread t))))
  16.     (cond
  17.       ( (and (= 2 (car gr)) (= 43 (cadr gr)))
  18.         (setq lst2n (mapcar (function (lambda ( x ) (mapcar '+ pp (mapcar '* (mapcar '- x pp) (list (sqrt 2.0) (sqrt 2.0)))))) lst2n))
  19.       )
  20.       ( (and (= 2 (car gr)) (= 45 (cadr gr)))
  21.         (setq lst2n (mapcar (function (lambda ( x ) (mapcar '+ pp (mapcar '* (mapcar '- x pp) (list (/ (sqrt 2.0) 2.0) (/ (sqrt 2.0) 2.0)))))) lst2n))
  22.       )
  23.       ( (and (= 2 (car gr)) (= 52 (cadr gr)))
  24.         (setq lst2n (mapcar (function (lambda ( x ) (polar pp (+ (angle pp x) (/ pi 4.0)) (distance pp x)))) lst2n))
  25.       )
  26.       ( (and (= 2 (car gr)) (= 54 (cadr gr)))
  27.         (setq lst2n (mapcar (function (lambda ( x ) (polar pp (- (angle pp x) (/ pi 4.0)) (distance pp x)))) lst2n))
  28.       )
  29.       ( t
  30.         (if (null pp)
  31.           (setq pp (cadr gr))
  32.         )
  33.         (setq v (mapcar '- pp p))
  34.         (if (null lst2n)
  35.           (setq lst2n (mapcar (function (lambda ( x ) (mapcar '+ v x))) lst2))
  36.           (progn
  37.             (setq lst2n (mapcar (function (lambda ( x ) (mapcar '+ (mapcar '- (cadr gr) pp) x))) lst2n))
  38.             (setq pp (cadr gr))
  39.           )
  40.         )
  41.       )
  42.     )
  43.     (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))))
  44.     (mapcar (function (lambda ( a x ) (entmod (subst (cons 11 a) (assoc 11 (entget x)) (entget x))))) lst2n lil)
  45.     (redraw)
  46.   )
  47.   (princ)
  48. )

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2020-4-2 17:43 | 显示全部楼层
pengfei2010 发表于 2020-4-2 14:13
你这个平面生成立面是根据什么规则生成的呀,我看了好几遍都没有看明白!

使用 grread函数 去抓滑鼠及鍵盤
這裡有介紹:
http://bbs.mjtd.com/thread-91191-1-1.html
 楼主| 发表于 2020-3-30 23:08 | 显示全部楼层
墨雨尘峰 发表于 2020-3-30 22:48
好东西啊,但是我这边有 错误: no function definition: XJTC

删除(xjtc)再把需要的图层名都改成你用的图层或者都改成 0 层
发表于 2020-3-30 22:48 | 显示全部楼层
好东西啊,但是我这边有 错误: no function definition: XJTC
发表于 2020-3-31 08:42 | 显示全部楼层
东西不错 可惜  权限不够
发表于 2020-3-31 15:37 | 显示全部楼层
还不可以看  再回帖
发表于 2020-4-1 08:52 | 显示全部楼层
画装饰施工图可以用到,
发表于 2020-4-2 14:13 | 显示全部楼层
你这个平面生成立面是根据什么规则生成的呀,我看了好几遍都没有看明白!
发表于 2020-4-3 09:02 | 显示全部楼层
lee50310 发表于 2020-4-2 17:43
使用 grread函数 去抓滑鼠及鍵盤
這裡有介紹:
http://bbs.mjtd.com/thread-91191-1-1.html

不知道有啥用处
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 12:57 , Processed in 0.247135 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表