明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1347|回复: 8

[源码] 动态建筑符号的【正交】程式摸索?

[复制链接]
发表于 2018-2-3 10:57 | 显示全部楼层 |阅读模式
本帖最后由 尘缘一生 于 2018-2-4 18:33 编辑

自己写的“动态折断线”,
很遗憾,在扯动中不能使用“正交”,如何完善修改呢?

  1. (defun c:ZDX(/ pt1 pt2 pt3 pt4 pt5 pt6 pt7 ang dis gr n %k i)  
  2.   (setq pt1 (getpoint "\ngive the left point:"))
  3.   (setq %k t) ;循环条件
  4.   (setq i nil);初始设置)
  5.   (while %k
  6.     (setq gr (grread t 4 0);;取得鼠标操作及坐标
  7.           n (car gr)       ;;鼠标操作
  8.           pt2 (cadr gr)     ;;鼠标坐标

  9.     )
  10.     (if (= n 5) ;;没有操作
  11.       (progn
  12.         (if (/= i nil)
  13.           (entdel i)
  14.         );;如果有过度实体就删除
  15.         (setq ang (angle pt1 pt2))
  16.         (setq dis (distance pt1 pt2))
  17.         (setq pt3 (polar pt1 ang (/ dis 2)))
  18.         (setq pt4 (polar pt1 ang (- (/ dis 2) 1.3)))
  19.         (setq pt5 (polar pt3 (+ ang (/ pi 2)) 3.5))
  20.         (setq pt6 (polar pt3 (- ang (/ pi 2)) 3.5))
  21.         (setq pt7 (polar pt1 ang (+ (/ dis 2) 1.3)))
  22.         (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '
  23.                        (90 . 5) (cons 10 pt1) (cons 10 pt4) (cons 10 pt5) (cons 10 pt6)
  24.                        (cons 10 pt7) (cons 10 pt2)
  25.                  )
  26.         )
  27.         (setq i (entlast));;得到过度实体名
  28.       )
  29.     )
  30.     (if (= n 3)
  31.       (setq %k nil)
  32.     );;3表示左键;结束循环
  33.     (if (or
  34.           (= n 2)
  35.           (= n 25)
  36.         );;2表示空格;25表示右键;结束循环
  37.       (progn
  38.         (setq %k nil)
  39.         (entdel i)
  40.       )
  41.     )
  42.   )
  43.   (print)
  44. )



总之:需要有正交功能的grread函数,谁有提供吗?非源码请绕行。






本帖子中包含更多资源

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

x

评分

参与人数 1明经币 +1 收起 理由
USER2128 + 1 赞一个!

查看全部评分

"觉得好,就打赏"
还没有人打赏,支持一下
 楼主| 发表于 2018-2-5 18:58 | 显示全部楼层
本帖最后由 尘缘一生 于 2018-2-5 22:04 编辑

总结本帖:
   建筑符号,已写完全,他们是:
1:折断线 ZDX
2:双折断线 ZDX1
3:箭头 JT
4:对称符号 duichen

特点:
grread方式且支持正交切换。
程序说明:
  程序内部进行了角度改写,已避免双折断线时线条交叉;
   程序适合PKPM系列,对于天正系列1:1画图来说,修改很简单,或者在实用中,把天正图纸缩小0.01倍即可
源码程序如下:








本帖子中包含更多资源

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

x
回复 支持 1 反对 0

使用道具 举报

 楼主| 发表于 2018-2-4 09:29 | 显示全部楼层
本帖最后由 尘缘一生 于 2018-2-4 09:41 编辑

终于实现了正交:程序“扑捉”部分功能暂时去掉了,经试验,不完善。

  1. (defun c:ZDX-1 (/ pt1 pt2 ennext ang gr grr z)
  2.   (setq pt1 (getpoint "\n给出起点?give the first point:"))
  3.   (setq f8(getvar 'ORTHOMODE))
  4.   (setvar 'cmdecho 0)
  5.   (setq z t)
  6.   (while z
  7.     (setq grr (grread t ));请求输入
  8.     (setq gr(car grr) pt2 (cadr grr))
  9.     (cond
  10.       ((equal grr '(2 15));F8切换正交开关
  11.         (if (= f8 0)
  12.           (progn(setq f8 1)(prompt "\n<正交 开>"))
  13.           (progn(setq f8 0)(prompt "\n<正交 关>"))
  14.         )
  15.         (setvar 'orthomode f8)(redraw)
  16.       )
  17.       ((= gr 5);移动时
  18.         (cond ((= f8 1);正交打开时
  19.                 (setq ang (atoi (angtos (angle pt1 pt2))))
  20.                 (if(> ang 315)(setq ang (- 360 ang)))
  21.                 (cond ((and (< ang 45) (> ang -45))
  22.                         (setq pt (list (car pt2) (cadr pt1)))
  23.                       )
  24.                   ((and (< ang 135) (> ang 45))
  25.                     (setq pt (list (car pt1) (cadr pt2)))
  26.                   )
  27.                   ((and (< ang 225) (> ang 135))
  28.                     (setq pt (list (car pt2) (cadr pt1)))
  29.                   )
  30.                   ((and (< ang 315) (> ang 225))
  31.                     (setq pt (list (car pt1) (cadr pt2)))
  32.                   )
  33.                 )
  34.               )   
  35.           ((= f8 0)(setq pt pt2));正交关闭时
  36.         )  
  37.         (entmake-zdx);生成引线|;
  38.       )   
  39.       ((= gr 3);左击
  40.         (setq z nil)
  41.       )
  42.       ((or(equal grr '(2 32));空格
  43.          (equal grr '(2 13));回车
  44.          (equal grr'(11 0));右击
  45.        )
  46.         (setq z nil)
  47.       )   
  48.     )
  49.   )
  50.   (redraw)
  51.   (setvar 'cmdecho 1)
  52.   (princ)
  53. )

  54. ;;;
  55. (defun entmake-zdx(/ ang dis pt3 pt4 pt5 pt6 pt7);;;生成折断线
  56.   (if ennext (entdel ennext));;删除上次画的线
  57.   (setq ang (angle pt1 pt))
  58.   (setq dis (distance pt1 pt))
  59.   (setq pt3 (polar pt1 ang (/ dis 2)))
  60.   (setq pt4 (polar pt1 ang (- (/ dis 2) 1.3)))
  61.   (setq pt5 (polar pt3 (+ ang (/ pi 2)) 3.5))
  62.   (setq pt6 (polar pt3 (- ang (/ pi 2)) 3.5))
  63.   (setq pt7 (polar pt1 ang (+ (/ dis 2) 1.3)))
  64.   (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '
  65.              (90 . 5) (cons 10 pt1) (cons 10 pt4) (cons 10 pt5) (cons 10 pt6)
  66.              (cons 10 pt7) (cons 10 pt)
  67.            )
  68.   )
  69.   (setq ennext (entlast));;提取刚划的线
  70. )


 楼主| 发表于 2018-2-4 18:27 | 显示全部楼层
本帖最后由 尘缘一生 于 2018-2-5 18:51 编辑

应用实例:
两个命令:折断线;箭头

发过来,立春了,给论坛拜年,更有两点期望:
1:线性建筑符号,还有:对称符号;双折断线等,希望谁能编出来下,按这种办法编写,基本就是高仿PKPM的,很实用。
2:下面这个应用实例,整合的自以为很不好,不知道谁能改写,整合好一些呢?

  1. (defun C:JT-2();;;画箭头符号,支持正交
  2.   (jzfh 2)
  3. )
  4. (defun C:ZDX-2();;;;画折断线符号,支持正交
  5.   (jzfh 1)
  6. )
  7. (defun jzfh (k / ennext pt1 pt2 ang gr grr z)
  8.   (setq pt1 (getpoint "\n给出起点?give the first point:"))
  9.   (setq f8(getvar 'ORTHOMODE))
  10.   (setvar 'cmdecho 0)
  11.   (setq z t)
  12.   (while z
  13.     (setq grr (grread t ));请求输入
  14.     (setq gr(car grr) pt2 (cadr grr))
  15.     (cond
  16.       ((equal grr '(2 15));F8切换正交开关
  17.         (if (= f8 0)
  18.           (progn(setq f8 1)(prompt "\n<正交 开>"))
  19.           (progn(setq f8 0)(prompt "\n<正交 关>"))
  20.         )
  21.         (setvar 'orthomode f8)(redraw)
  22.       )
  23.       ((= gr 5);移动时
  24.         (cond ((= f8 1);正交打开时
  25.                 (setq ang (atoi (angtos (angle pt1 pt2))))
  26.                 (if(> ang 315)(setq ang (- 360 ang)))
  27.                 (cond ((and (< ang 45) (> ang -45))
  28.                         (setq pt (list (car pt2) (cadr pt1)))
  29.                       )
  30.                   ((and (< ang 135) (> ang 45))
  31.                     (setq pt (list (car pt1) (cadr pt2)))
  32.                   )
  33.                   ((and (< ang 225) (> ang 135))
  34.                     (setq pt (list (car pt2) (cadr pt1)))
  35.                   )
  36.                   ((and (< ang 315) (> ang 225))
  37.                     (setq pt (list (car pt1) (cadr pt2)))
  38.                   )
  39.                 )
  40.               )   
  41.           ((= f8 0)(setq pt pt2));正交关闭时
  42.         )  
  43.         (if (= k 1)
  44.           (progn
  45.             ;;;(command "LAYER" "S" "MM" "")
  46.             (if ennext (entdel ennext));;删除上次画的实体
  47.             (entmake-zdx);生成折断线|;
  48.             (setq ennext (entlast));;提取刚画的实体
  49.             ;;;(command "LAYER" "S" "0SX" "")
  50.           )
  51.       )
  52.       (if (= k 2)
  53.         (progn
  54.         ;;;  (command "LAYER" "S" "MM" "")
  55.           (entmake-jt);生成箭头|;
  56.         ;;;  (command "LAYER" "S" "0SX" "")
  57.         )
  58.       )
  59.     )   
  60.     ((= gr 3);左击
  61.       (setq z nil)
  62.     )
  63.     ((or(equal grr '(2 32));空格
  64.        (equal grr '(2 13));回车
  65.        (equal grr'(11 0));右击
  66.      )
  67.       (setq z nil)
  68.     )   
  69.   )
  70. )
  71. (redraw)
  72. (setvar 'cmdecho 1)
  73. (princ)
  74. )

  75. ;;;
  76. (defun entmake-zdx(/ ang dis pt3 pt4 pt5 pt6 pt7);;;生成折断线  
  77.   (setq ang (angle pt1 pt))
  78.   (setq dis (distance pt1 pt))
  79.   (setq pt3 (polar pt1 ang (/ dis 2)))
  80.   (setq pt4 (polar pt1 ang (- (/ dis 2) 1.3)))
  81.   (setq pt5 (polar pt3 (+ ang (/ pi 2)) 3.5))
  82.   (setq pt6 (polar pt3 (- ang (/ pi 2)) 3.5))
  83.   (setq pt7 (polar pt1 ang (+ (/ dis 2) 1.3)))
  84.   (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '
  85.              (90 . 5) (cons 10 pt1) (cons 10 pt4) (cons 10 pt5) (cons 10 pt6)
  86.              (cons 10 pt7) (cons 10 pt)
  87.            )
  88.   )
  89. )
  90. ;;;;;
  91. (defun entmake-jt(/ ang dis pt3 pt4);;;生成箭头
  92.   (if ennext (progn
  93.                (entdel(ssname  ennext  0))
  94.                (entdel(ssname  ennext  1))
  95.              )
  96.   );;删除上次画的实体
  97.   (setq ang (angle pt1 pt))
  98.   (setq dis (distance pt1 pt))
  99.   (setq pt3 (polar pt (- (+ pi ang) 0.25) 5))
  100.   (setq pt4 (polar pt (- 0.0 (- (- pi ang) 0.25)) 5))
  101.   (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '
  102.              (90 . 5) (cons 10 pt1) (cons 10 pt) (cons 10 pt3)
  103.            )
  104.   )
  105.   (setq ennext(ssadd))
  106.   (ssadd (entlast) ennext)
  107.   (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '
  108.              (90 . 5) (cons 10 pt) (cons 10 pt4)
  109.            )
  110.   )
  111.   (ssadd (entlast) ennext)
  112. )








本帖子中包含更多资源

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

x
发表于 2018-2-5 17:02 | 显示全部楼层
谢谢楼主分享。程序中的折线对我来说比较小,我给改大了。另外又加了一条折线。
下载链接见:
演示动画见:



本帖子中包含更多资源

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

x

点评

因为你是1:1画图,我编写的是源自:中科院DOS版那时候始,系统的历史继承,基本是1000倍关系。  发表于 2018-2-5 17:33
发表于 2018-8-7 00:43 | 显示全部楼层
学习,学习!研究一下!
发表于 2018-8-7 07:16 | 显示全部楼层
下载学习,感谢分享!!!!!!
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-3-29 04:38 , Processed in 0.252776 second(s), 33 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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