明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
12
返回列表 发新帖
楼主: 小小品客

[求助]急求一个加高程点的小程序

  [复制链接]
发表于 2013-1-8 17:26 | 显示全部楼层
;;;201107311130wkq004@qq.com
(defun c:tt ()
  (setvar "osmode" 512)
  (command "layer" "s" "gcd" "")
  (setq p1 (getpoint "\n请输入点位置:"))
  (setq p2 (getpoint "\n请输入点位置:"))
  (setq a1 (caddr p1))
  (setq a2 (caddr p2))
;;;  (setq a3 (/ (- a1 a2) 2))
;;;  (setq a4 (- (caddr p1) a3))
  (setq s1 (distance p1 p2))
  (setvar "osmode" 0)
  (setvar "thickness" 1610000)
  (setq xh 1)
  (while (= 1 xh)
    (setq TMP  (grread T 15 1)
          MODE (car TMP)
          val  (cadr TMP)
    )
    (redraw)
    (cond
      ((= 5 MODE)
       (progn
         (grdraw p1 val -1)
         (grdraw p2 val -1)
         (grdraw p1 p2 -1)
       )
      )
      ((= 3 MODE)
       (progn
         (setq val (list (car val) (cadr val)))
         (setq ang1 (abs (- (atof (angtos (angle p1 val) 0 4))
                            (atof (angtos (angle p1 p2) 0 4))
                         )
                    )
         )
         (if (> ang1 180)
           (setq ang1 (- 360 ang1))
         )

         (setq ang2 (abs (- (atof (angtos (angle p2 val) 0 4))
                            (atof (angtos (angle p2 p1) 0 4))
                         )
                    )
         )
         (if (> ang2 180)
           (setq ang2 (- 360 ang2))
         )
         (if (< (+ ang1 ang2) 90)
           (progn
             (redraw)
             (setq
               dist1 (* (cos (* pi (/ ang1 180.0))) (distance p1 val))
             )
             (if (> a1 a2)
               (setq bili+- -1)
               (setq bili+- 1)
             )
             (setq gaocheng
                    (+ a1
                       (* bili+- (/ dist1 (distance p1 p2)) (abs (- a1 a2)))
                    )
             )
             (setq ptz (append val (list gaoCheng)))
;;;             (setq p4 (subst gaocheng a1 val))
             (setq text (rtos gaocheng 2 1))
;;;             (setq p5 (list (+ (car p4) 1) (nth 1 p4) gaocheng))
;;;             (command "point" p4)
;;;             (command "text" p5 "2.0" "" text)

             (entmake (list (cons 0 "POINT")
                            (cons 10 ptz)
                      )
             )
             (entmake
               (list (cons 0 "TEXT")
                     (cons 1 text)
                     (cons 10 ptz)
                     (cons 40 2.0)
;;;                     (cons 73 2)
               )
             )
             (setq xh 0)
           )
         )
       )
      )
      ((= 25 MODE)
       ;;右击
       (progn
         (redraw)
         (setq xh 0)
       )
      )
    )
  )
  (setvar "thickness" 0)
  (command "layer" "s" "0" "")
  (princ)
)
发表于 2013-1-8 18:54 | 显示全部楼层
到004发功力了
发表于 2019-6-15 21:47 | 显示全部楼层
兄弟,也给小弟发一份吧,先谢谢了  283528149@qq.com
发表于 2019-10-14 23:54 来自手机 | 显示全部楼层
谢谢分享,支持
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-3-28 22:44 , Processed in 0.136184 second(s), 16 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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