z073445 发表于 2011-9-7 10:43:01

谢谢楼主    非常强大的功能

zqplw 发表于 2011-9-14 09:47:13

请问大虾您有那个程序吗我急用啊

唐宗密 发表于 2011-11-14 09:51:37

你给的 dsgc ，jlgc，sgc，plgc，这几个命令是在CASS里面运行的吗



momokill 发表于 2013-1-9 23:46:55

下载不来，谁再共享一下

004 发表于 2013-1-10 17:28:35

本帖最后由 004 于 2013-1-10 17:30 编辑



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

(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)
)

xiabin68 发表于 2013-1-10 20:34:57

004 发表于 2013-1-10 17:28 static/image/common/back.gif


好程序啊，，，，，，

杨光88888888 发表于 2013-4-5 20:44:26

下来试试
页: 1 [2]
查看完整版本: 关于加高程点