求修改标高代码~

flytoday

(defun c:PDBG ( / 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 '+ '(100 100 0) pt1))
                 (cons 12 (mapcar '+ '(-100 100 0) pt1))
                 (cons 13 (mapcar '+ '(-100 100 0) pt1))
           )
  )
  (entmake (list '(0 . "text")
;                '(8 . "PUB_TEXT");默认有该图层
                 '(10 0 0 0)
                 (cons 11 (mapcar '+ '(0 100 0) pt1))
                 (cons 1 (rtos bg1 2 3))
                 '(40 . 200)
                 '(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 '+ '(100 100 0) pt2))
                 (cons 12 (mapcar '+ '(-100 100 0) pt2))
                 (cons 13 (mapcar '+ '(-100 100 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 100 0) pt2))
                 (cons 1 (rtos bgx 2 3))
                 '(40 . 200)
                 '(41 . 0.75)
                 (cons 50 0)
   ;              '(7 . "_TCH_DIM");默认有该样式
                 '(72 . 1)
                 '(73 . 0)
           )
  )
  )
  (setvar "osmode" oldos)
  (princ)
)

flytoday

坡道起点以前一点为基点计算~
原插件只能水平垂直有效。。。斜的无效~~

求大师给修改下谢谢~~~~~~~~~~~~~~~~~~~~~~~~

flytoday

坡道起点以前一点为基点计算~
原插件只能水平垂直有效。。。斜的无效~~

求大师给修改下谢谢~~~~~~~~~~~~~~~~~~~~~~~~

flytoday

哪位大师出手改下啊谢谢~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

sachindkini

dear sir,

Program Description

This relatively simple program allows the user to continuously place elevation markers composed of a variable width polyline and single-line text object at specific points in a drawing.

The program will continuously prompt the user for a point at which to display the elevation, and proceed to create an LWPolyline marker accompanied by a single-line Text object displaying the value of the UCS Y-coordinate of the picked point.

Precision of the Units and the value displayed are controlled by the settings of the LUNITS and LUPREC system variables respectively.   

The text height, offset and Size of the marker are all dependent upon the value of the TEXTSIZE system variable.  

[Attach] 81706 [/ attach]

sachindkini

dear sir,
see attached file
for u r reference  

flytoday

sachindkini 发表于 2014-2-25 13:46
dear sir,
see attached file
for u r reference

哥我不是要这种效果……谢谢………与长度有关系的

edata

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

(defun c:PDBG ( / oldos pt1 pd ptx bg1 bgx disx pt2 dz_old)<br />   (setq oldos (getvar "osmode"))<br />   (setvar "osmode" 513)<br />   (setq dz_old(getvar 'dimzin))<br />   (setvar 'dimzin 0)<br />   (setq pt1  (getpoint "\n选择起点:")<br />         bg1  (getreal "\n输入起点标高<0.000>:")<br />         pd  (getreal "\n输入终坡度:")<br />   )<br />   (or bg1 (setq bg1 0.0))<br />   (if (and pt1 bg1 pd)<br />     (progn<br />   (entmake (list '(0 . "SOLID")<br />    ;              '(8 . "DIM_ELEV");默认有该图层<br />                  (cons 10 pt1)<br />                  (cons 11 (mapcar '+ '(100 100 0) pt1))<br />                  (cons 12 (mapcar '+ '(-100 100 0) pt1))<br />                  (cons 13 (mapcar '+ '(-100 100 0) pt1))<br />            )<br />   )<br />   (entmake (list '(0 . "text")<br /> ;                '(8 . "PUB_TEXT");默认有该图层<br />                  '(10 0 0 0)<br />                  (cons 11 (mapcar '+ '(0 100 0) pt1))<br />                  (cons 1 (rtos bg1 2 3))<br />                  '(40 . 200)<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 pt1 "\n选择插入点:"))<br />     (setq disx (* (distance pt1 ptx) 0.001)<br />           bgx  (+ bg1 (* disx pd))<br />           pt2 (mapcar '+ (list 0 (- bgx bg1) 0) ptx)<br />     pt1 ptx<br />     bg1 bgx<br />     )<br />       (entmake (list '(0 . "SOLID")<br />     ;             '(8 . "DIM_ELEV");默认有该图层<br />                  (cons 10 pt2)<br />                  (cons 11 (mapcar '+ '(100 100 0) pt2))<br />                  (cons 12 (mapcar '+ '(-100 100 0) pt2))<br />                  (cons 13 (mapcar '+ '(-100 100 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 100 0) pt2))<br />                  (cons 1 (rtos bgx 2 3))<br />                  '(40 . 200)<br />                  '(41 . 0.75)<br />                  (cons 50 0)<br />    ;              '(7 . "_TCH_DIM");默认有该样式<br />                  '(72 . 1)<br />                  '(73 . 0)<br />            )<br />   )<br />   )<br />   )<br />     )<br />   (setvar 'dimzin dz_old)<br />   (setvar "osmode" oldos)<br />   (princ)<br /> )

edata

sachindkini 发表于 2014-2-25 13:46
dear sir,
see attached file
for u r reference

Add base point,haha~

峰云于雾

edata 发表于 2014-2-25 18:35
Add base point,haha~

插件很给力，不过如果能增加设置标注文字及符号的大小就非常好了（把符号做成块，可以自由快速的修改格式），如果能增加类似坐标检查的功能就完美了。