明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
12
返回列表 发新帖
楼主: yjpzc

关于加高程点

  [复制链接]
发表于 2011-9-7 10:43:01 | 显示全部楼层
谢谢楼主    非常强大的功能
发表于 2011-9-14 09:47:13 | 显示全部楼层
请问大虾  您有那个程序吗  我急用啊
发表于 2011-11-14 09:51:37 | 显示全部楼层
你给的 dsgc ,jlgc,sgc,plgc,这几个命令是在CASS里面运行的吗



发表于 2013-1-9 23:46:55 来自手机 | 显示全部楼层
下载不来,谁再共享一下
发表于 2013-1-10 17:28:35 | 显示全部楼层
本帖最后由 004 于 2013-1-10 17:30 编辑

  1. ;;;201107311130wkq004@qq.com
  2. ;;;cass加高程点

  3. (defun c:tt ()
  4.   (setvar "osmode" 512)
  5.   (command "layer" "s" "gcd" "")
  6.   (setq p1 (getpoint "\n请输入点位置:"))
  7.   (setq p2 (getpoint "\n请输入点位置:"))
  8.   (setq a1 (caddr p1))
  9.   (setq a2 (caddr p2))
  10. ;;;  (setq a3 (/ (- a1 a2) 2))
  11. ;;;  (setq a4 (- (caddr p1) a3))
  12.   (setq s1 (distance p1 p2))
  13.   (setvar "osmode" 0)
  14.   (setvar "thickness" 1610000)
  15.   (setq xh 1)
  16.   (while (= 1 xh)
  17.     (setq TMP  (grread T 15 1)
  18.           MODE (car TMP)
  19.           val  (cadr TMP)
  20.     )
  21.     (redraw)
  22.     (cond
  23.       ((= 5 MODE)
  24.        (progn
  25.          (grdraw p1 val -1)
  26.          (grdraw p2 val -1)
  27.          (grdraw p1 p2 -1)
  28.        )
  29.       )
  30.       ((= 3 MODE)
  31.        (progn
  32.          (setq val (list (car val) (cadr val)))
  33.          (setq ang1 (abs (- (atof (angtos (angle p1 val) 0 4))
  34.                             (atof (angtos (angle p1 p2) 0 4))
  35.                          )
  36.                     )
  37.          )
  38.          (if (> ang1 180)
  39.            (setq ang1 (- 360 ang1))
  40.          )

  41.          (setq ang2 (abs (- (atof (angtos (angle p2 val) 0 4))
  42.                             (atof (angtos (angle p2 p1) 0 4))
  43.                          )
  44.                     )
  45.          )
  46.          (if (> ang2 180)
  47.            (setq ang2 (- 360 ang2))
  48.          )
  49.          (if (< (+ ang1 ang2) 90)
  50.            (progn
  51.              (redraw)
  52.              (setq
  53.                dist1 (* (cos (* pi (/ ang1 180.0))) (distance p1 val))
  54.              )
  55.              (if (> a1 a2)
  56.                (setq bili+- -1)
  57.                (setq bili+- 1)
  58.              )
  59.              (setq gaocheng
  60.                     (+ a1
  61.                        (* bili+- (/ dist1 (distance p1 p2)) (abs (- a1 a2)))
  62.                     )
  63.              )
  64.              (setq ptz (append val (list gaoCheng)))
  65. ;;;             (setq p4 (subst gaocheng a1 val))
  66.              (setq text (rtos gaocheng 2 1))
  67. ;;;             (setq p5 (list (+ (car p4) 1) (nth 1 p4) gaocheng))
  68. ;;;             (command "point" p4)
  69. ;;;             (command "text" p5 "2.0" "" text)

  70.              (entmake (list (cons 0 "POINT")
  71.                             (cons 10 ptz)
  72.                       )
  73.              )
  74.              (entmake
  75.                (list (cons 0 "TEXT")
  76.                      (cons 1 text)
  77.                      (cons 10 ptz)
  78.                      (cons 40 2.0)
  79. ;;;                     (cons 73 2)
  80.                )
  81.              )
  82.              (setq xh 0)
  83.            )
  84.          )
  85.        )
  86.       )
  87.       ((= 25 MODE)
  88.        ;;右击
  89.        (progn
  90.          (redraw)
  91.          (setq xh 0)
  92.        )
  93.       )
  94.     )
  95.   )
  96.   (setvar "thickness" 0)
  97.   (command "layer" "s" "0" "")
  98.   (princ)
  99. )
发表于 2013-1-10 20:34:57 | 显示全部楼层
004 发表于 2013-1-10 17:28

好程序啊,,,,,,
发表于 2013-4-5 20:44:26 | 显示全部楼层
下来试试
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-11-15 07:06 , Processed in 0.147181 second(s), 18 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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