求依据坡度水平线标注标高。求高手出手谢谢

flytoday

测试文件：

操作：
1---指定起点输入标高
2---指定方向并输入坡度值
3---进行标高标高并生成高度线
麻烦哪位高手出手帮忙谢谢。。。。。。。

夏生生

直线的比例不是很清楚，按照1：1000写的，您试试看，有什么问题再改

2. (defun c:test1 ( / oldos pt1 pd ptx bg1 bgx disx pt2)
   
3.   (setq oldos (getvar "osmode"))
   
4.   (setvar "osmode" 513)
   
5.   (setq        pt1  (getpoint "\n选择起点:")
   
6.         bg1  (getreal "\n输入起点标高:")
   
7.         pd  (getreal "\n输入终坡度:")
   
8.   )
   
9.   (entmake (list '(0 . "SOLID")
   
10.                  '(8 . "DIM_ELEV");默认有该图层
    
11.                  (cons 10 pt1)
    
12.                  (cons 11 (mapcar '+ '(300 300 0) pt1))
    
13.                  (cons 12 (mapcar '+ '(-300 300 0) pt1))
    
14.                  (cons 13 (mapcar '+ '(-300 300 0) pt1))
    
15.            )
    
16.   )
    
17.   (entmake (list '(0 . "text")
    
18.                  '(8 . "PUB_TEXT");默认有该图层
    
19.                  '(10 0 0 0)
    
20.                  (cons 11 (mapcar '+ '(0 400 0) pt1))
    
21.                  (cons 1 (rtos bg1 2 3))
    
22.                  '(40 . 300)
    
23.                  '(41 . 0.75)
    
24.                  (cons 50 0)
    
25.                  '(7 . "_TCH_DIM");默认有该样式
    
26.                  '(72 . 1)
    
27.                  '(73 . 0)
    
28.            )
    
29.   )
    
30.   (while (setq ptx (getpoint "\n选择插入点:"))
    
31.     (setq disx (/(distance pt1 ptx)1000)
    
32.           bgx  (+ bg1 (* disx pd))
    
33.           pt2 (mapcar '+ (list 0 (- bgx bg1) 0) ptx)
    
34.     )
    
35.       (entmake (list '(0 . "SOLID")
    
36.                  '(8 . "DIM_ELEV");默认有该图层
    
37.                  (cons 10 pt2)
    
38.                  (cons 11 (mapcar '+ '(300 300 0) pt2))
    
39.                  (cons 12 (mapcar '+ '(-300 300 0) pt2))
    
40.                  (cons 13 (mapcar '+ '(-300 300 0) pt2))
    
41.            )
    
42.   )
    
43.     (entmake (list '(0 . "line")
    
44.                    (cons 10 ptx)
    
45.                    (cons 11 pt2)
    
46.              )
    
47.     )
    
48.   (entmake (list '(0 . "text")
    
49.                  '(8 . "PUB_TEXT");默认有该图层
    
50.                  '(10 0 0 0)
    
51.                  (cons 11 (mapcar '+ '(0 400 0) pt2))
    
52.                  (cons 1 (rtos bgx 2 3))
    
53.                  '(40 . 300)
    
54.                  '(41 . 0.75)
    
55.                  (cons 50 0)
    
56.                  '(7 . "_TCH_DIM");默认有该样式
    
57.                  '(72 . 1)
    
58.                  '(73 . 0)
    
59.            )
    
60.   )
    
61.   )
    
62.   (setvar "osmode" oldos)
    
63.   (princ)
    
64. )

(defun c:test1 ( / oldos pt1 pd ptx bg1 bgx disx pt2)<br />   (setq oldos (getvar "osmode"))<br />   (setvar "osmode" 513)<br />   (setq        pt1  (getpoint "\n选择起点:")<br />         bg1  (getreal "\n输入起点标高:")<br />         pd  (getreal "\n输入终坡度:")<br />   )<br />   (entmake (list '(0 . "SOLID")<br />                  '(8 . "DIM_ELEV");默认有该图层<br />                  (cons 10 pt1)<br />                  (cons 11 (mapcar '+ '(300 300 0) pt1))<br />                  (cons 12 (mapcar '+ '(-300 300 0) pt1))<br />                  (cons 13 (mapcar '+ '(-300 300 0) pt1))<br />            )<br />   )<br />   (entmake (list '(0 . "text")<br />                  '(8 . "PUB_TEXT");默认有该图层<br />                  '(10 0 0 0)<br />                  (cons 11 (mapcar '+ '(0 400 0) pt1))<br />                  (cons 1 (rtos bg1 2 3))<br />                  '(40 . 300)<br />                  '(41 . 0.75)<br />                  (cons 50 0)<br />                  '(7 . "_TCH_DIM");默认有该样式<br />                  '(72 . 1)<br />                  '(73 . 0)<br />            )<br />   )<br />   (while (setq ptx (getpoint "\n选择插入点:"))<br />     (setq disx (/(distance pt1 ptx)1000)<br />           bgx  (+ bg1 (* disx pd))<br />           pt2 (mapcar '+ (list 0 (- bgx bg1) 0) ptx)<br />     )<br />       (entmake (list '(0 . "SOLID")<br />                  '(8 . "DIM_ELEV");默认有该图层<br />                  (cons 10 pt2)<br />                  (cons 11 (mapcar '+ '(300 300 0) pt2))<br />                  (cons 12 (mapcar '+ '(-300 300 0) pt2))<br />                  (cons 13 (mapcar '+ '(-300 300 0) pt2))<br />            )<br />   )<br />     (entmake (list '(0 . "line")<br />                    (cons 10 ptx)<br />                    (cons 11 pt2)<br />              )<br />     )<br />   (entmake (list '(0 . "text")<br />                  '(8 . "PUB_TEXT");默认有该图层<br />                  '(10 0 0 0)<br />                  (cons 11 (mapcar '+ '(0 400 0) pt2))<br />                  (cons 1 (rtos bgx 2 3))<br />                  '(40 . 300)<br />                  '(41 . 0.75)<br />                  (cons 50 0)<br />                  '(7 . "_TCH_DIM");默认有该样式<br />                  '(72 . 1)<br />                  '(73 . 0)<br />            )<br />   )<br />   )<br />   (setvar "osmode" oldos)<br />   (princ)<br /> )

flytoday

沉滴好快顶起哈………

flytoday

最好图纸中能选择指定图层图。。
关于样式最好能取得图纸中的当前样式。。

麻烦了谢谢~~~~~~~~~~~~~~~~

flytoday

哪位路过滴大师能改改谢谢

flytoday

哪位路过滴大师能改改谢谢

夏生生

flytoday 发表于 2012-12-22 08:45
哪位路过滴大师能改改谢谢

(defun c:test1 ( / oldos pt1 pd ptx bg1 bgx disx pt2)
  (setq oldos (getvar "osmode"))
  (setvar "osmode" 513)
  (setq        pt1  (getpoint "\n选择起点:")
        bg1  (getreal "\n输入起点标高:")
        pd  (getreal "\n输入终坡度:")
  )
  (entmake (list '(0 . "SOLID")
   ;              '(8 . "DIM_ELEV");默认有该图层
                 (cons 10 pt1)
                 (cons 11 (mapcar '+ '(300 300 0) pt1))
                 (cons 12 (mapcar '+ '(-300 300 0) pt1))
                 (cons 13 (mapcar '+ '(-300 300 0) pt1))
           )
  )
  (entmake (list '(0 . "text")
;                '(8 . "PUB_TEXT");默认有该图层
                 '(10 0 0 0)
                 (cons 11 (mapcar '+ '(0 400 0) pt1))
                 (cons 1 (rtos bg1 2 3))
                 '(40 . 300)
                 '(41 . 0.75)
                 (cons 50 0)
    ;             '(7 . "_TCH_DIM");默认有该样式
                 '(72 . 1)
                 '(73 . 0)
           )
  )
  (while (setq ptx (getpoint "\n选择插入点:"))
    (setq disx (/(distance pt1 ptx)1000)
          bgx  (+ bg1 (* disx pd))
          pt2 (mapcar '+ (list 0 (- bgx bg1) 0) ptx)
    )
      (entmake (list '(0 . "SOLID")
    ;             '(8 . "DIM_ELEV");默认有该图层
                 (cons 10 pt2)
                 (cons 11 (mapcar '+ '(300 300 0) pt2))
                 (cons 12 (mapcar '+ '(-300 300 0) pt2))
                 (cons 13 (mapcar '+ '(-300 300 0) pt2))
           )
  )
    (entmake (list '(0 . "line")
                   (cons 10 ptx)
                   (cons 11 pt2)
             )
    )
  (entmake (list '(0 . "text")
      ;           '(8 . "PUB_TEXT");默认有该图层
                 '(10 0 0 0)
                 (cons 11 (mapcar '+ '(0 400 0) pt2))
                 (cons 1 (rtos bgx 2 3))
                 '(40 . 300)
                 '(41 . 0.75)
                 (cons 50 0)
   ;              '(7 . "_TCH_DIM");默认有该样式
                 '(72 . 1)
                 '(73 . 0)
           )
  )
  )
  (setvar "osmode" oldos)
  (princ)
)

flytoday

现在代码不受指定图层与样式限制了
可以用了谢谢大师出手相助
非常感谢

众山小

确实不错，建筑设计中绘制车道非常有用！此程序中的标高是从低由高增加的。程序是否可以增加标高由高向低呢？谢谢！

恬逸

不知道运行命令啊。