关于加高程点

z073445

谢谢楼主    非常强大的功能

zqplw

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

唐宗密

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

momokill

下载不来，谁再共享一下

004

1. ;;;201107311130wkq004@qq.com
   
2. ;;;cass加高程点
   
3. 
   
4. (defun c:tt ()
   
5.   (setvar "osmode" 512)
   
6.   (command "layer" "s" "gcd" "")
   
7.   (setq p1 (getpoint "\n请输入点位置:"))
   
8.   (setq p2 (getpoint "\n请输入点位置:"))
   
9.   (setq a1 (caddr p1))
   
10.   (setq a2 (caddr p2))
    
11. ;;;  (setq a3 (/ (- a1 a2) 2))
    
12. ;;;  (setq a4 (- (caddr p1) a3))
    
13.   (setq s1 (distance p1 p2))
    
14.   (setvar "osmode" 0)
    
15.   (setvar "thickness" 1610000)
    
16.   (setq xh 1)
    
17.   (while (= 1 xh)
    
18.     (setq TMP  (grread T 15 1)
    
19.           MODE (car TMP)
    
20.           val  (cadr TMP)
    
21.     )
    
22.     (redraw)
    
23.     (cond
    
24.       ((= 5 MODE)
    
25.        (progn
    
26.          (grdraw p1 val -1)
    
27.          (grdraw p2 val -1)
    
28.          (grdraw p1 p2 -1)
    
29.        )
    
30.       )
    
31.       ((= 3 MODE)
    
32.        (progn
    
33.          (setq val (list (car val) (cadr val)))
    
34.          (setq ang1 (abs (- (atof (angtos (angle p1 val) 0 4))
    
35.                             (atof (angtos (angle p1 p2) 0 4))
    
36.                          )
    
37.                     )
    
38.          )
    
39.          (if (> ang1 180)
    
40.            (setq ang1 (- 360 ang1))
    
41.          )
    
42. 
    
43.          (setq ang2 (abs (- (atof (angtos (angle p2 val) 0 4))
    
44.                             (atof (angtos (angle p2 p1) 0 4))
    
45.                          )
    
46.                     )
    
47.          )
    
48.          (if (> ang2 180)
    
49.            (setq ang2 (- 360 ang2))
    
50.          )
    
51.          (if (< (+ ang1 ang2) 90)
    
52.            (progn
    
53.              (redraw)
    
54.              (setq
    
55.                dist1 (* (cos (* pi (/ ang1 180.0))) (distance p1 val))
    
56.              )
    
57.              (if (> a1 a2)
    
58.                (setq bili+- -1)
    
59.                (setq bili+- 1)
    
60.              )
    
61.              (setq gaocheng
    
62.                     (+ a1
    
63.                        (* bili+- (/ dist1 (distance p1 p2)) (abs (- a1 a2)))
    
64.                     )
    
65.              )
    
66.              (setq ptz (append val (list gaoCheng)))
    
67. ;;;             (setq p4 (subst gaocheng a1 val))
    
68.              (setq text (rtos gaocheng 2 1))
    
69. ;;;             (setq p5 (list (+ (car p4) 1) (nth 1 p4) gaocheng))
    
70. ;;;             (command "point" p4)
    
71. ;;;             (command "text" p5 "2.0" "" text)
    
72. 
    
73.              (entmake (list (cons 0 "POINT")
    
74.                             (cons 10 ptz)
    
75.                       )
    
76.              )
    
77.              (entmake
    
78.                (list (cons 0 "TEXT")
    
79.                      (cons 1 text)
    
80.                      (cons 10 ptz)
    
81.                      (cons 40 2.0)
    
82. ;;;                     (cons 73 2)
    
83.                )
    
84.              )
    
85.              (setq xh 0)
    
86.            )
    
87.          )
    
88.        )
    
89.       )
    
90.       ((= 25 MODE)
    
91.        ;;右击
    
92.        (progn
    
93.          (redraw)
    
94.          (setq xh 0)
    
95.        )
    
96.       )
    
97.     )
    
98.   )
    
99.   (setvar "thickness" 0)
    
100.   (command "layer" "s" "0" "")
     
101.   (princ)
     
102. )
     

;;;<a href="mailto:201107311130wkq004@qq.com" target="_blank">201107311130wkq004@qq.com</a><br /> ;;;cass加高程点<br /> <br /> (defun c:tt ()<br />   (setvar "osmode" 512)<br />   (command "layer" "s" "gcd" "")<br />   (setq p1 (getpoint "\n请输入点位置:"))<br />   (setq p2 (getpoint "\n请输入点位置:"))<br />   (setq a1 (caddr p1))<br />   (setq a2 (caddr p2))<br /> ;;;  (setq a3 (/ (- a1 a2) 2))<br /> ;;;  (setq a4 (- (caddr p1) a3))<br />   (setq s1 (distance p1 p2))<br />   (setvar "osmode" 0)<br />   (setvar "thickness" 1610000)<br />   (setq xh 1)<br />   (while (= 1 xh)<br />     (setq TMP  (grread T 15 1)<br />           MODE (car TMP)<br />           val  (cadr TMP)<br />     )<br />     (redraw)<br />     (cond<br />       ((= 5 MODE)<br />        (progn<br />          (grdraw p1 val -1)<br />          (grdraw p2 val -1)<br />          (grdraw p1 p2 -1)<br />        )<br />       )<br />       ((= 3 MODE)<br />        (progn<br />          (setq val (list (car val) (cadr val)))<br />          (setq ang1 (abs (- (atof (angtos (angle p1 val) 0 4))<br />                             (atof (angtos (angle p1 p2) 0 4))<br />                          )<br />                     )<br />          )<br />          (if (> ang1 180)<br />            (setq ang1 (- 360 ang1))<br />          )<br /> <br />          (setq ang2 (abs (- (atof (angtos (angle p2 val) 0 4))<br />                             (atof (angtos (angle p2 p1) 0 4))<br />                          )<br />                     )<br />          )<br />          (if (> ang2 180)<br />            (setq ang2 (- 360 ang2))<br />          )<br />          (if (< (+ ang1 ang2) 90)<br />            (progn<br />              (redraw)<br />              (setq<br />                dist1 (* (cos (* pi (/ ang1 180.0))) (distance p1 val))<br />              )<br />              (if (> a1 a2)<br />                (setq bili+- -1)<br />                (setq bili+- 1)<br />              )<br />              (setq gaocheng<br />                     (+ a1<br />                        (* bili+- (/ dist1 (distance p1 p2)) (abs (- a1 a2)))<br />                     )<br />              )<br />              (setq ptz (append val (list gaoCheng)))<br /> ;;;             (setq p4 (subst gaocheng a1 val))<br />              (setq text (rtos gaocheng 2 1))<br /> ;;;             (setq p5 (list (+ (car p4) 1) (nth 1 p4) gaocheng))<br /> ;;;             (command "point" p4)<br /> ;;;             (command "text" p5 "2.0" "" text)<br /> <br />              (entmake (list (cons 0 "POINT")<br />                             (cons 10 ptz)<br />                       )<br />              )<br />              (entmake<br />                (list (cons 0 "TEXT")<br />                      (cons 1 text)<br />                      (cons 10 ptz)<br />                      (cons 40 2.0)<br /> ;;;                     (cons 73 2)<br />                )<br />              )<br />              (setq xh 0)<br />            )<br />          )<br />        )<br />       )<br />       ((= 25 MODE)<br />        ;;右击<br />        (progn<br />          (redraw)<br />          (setq xh 0)<br />        )<br />       )<br />     )<br />   )<br />   (setvar "thickness" 0)<br />   (command "layer" "s" "0" "")<br />   (princ)<br /> )<br />

xiabin68

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

好程序啊，，，，，，

杨光88888888

下来试试