[求助]：谁帮我写一个标注标高的宏（AutoCADLT用）

cj2000

像这样斜线水平线构成的折线上面标注标高值，斜线指向标注点，自动获得标高值。
AutoCADLT的按钮用

标高值
------
/

efan2000

请说明清查点，如标高值保存在哪里，如何读取？

efan2000

提供个简单的例子，你可以参考一下。

2. 
   
3.   [FONT=courier new]
   
4. Sub Test()
   
5.     On Error Resume Next
   
6.     Dim pPt(0 To 7) As Double
   
7.     Dim sPt As Variant
   
8.     sPt = ThisDrawing.Utility.GetPoint(, "指定起点: ")
   
9.     If Err Then Exit Sub
   
10.     pPt(0) = sPt(0): pPt(1) = sPt(1)
    
11.     Dim ePt As Variant
    
12.     ePt = ThisDrawing.Utility.GetPoint(sPt, "指定终点: ")
    
13.     If Err Then Exit Sub
    
14.     sPt = ThisDrawing.Utility.PolarPoint(sPt, ThisDrawing.Utility.AngleFromXAxis(sPt, ePt), 2.5) '用于设置箭头长度
    
15.     pPt(2) = sPt(0): pPt(3) = sPt(1)
    
16.     pPt(4) = ePt(0): pPt(5) = ePt(1)
    
17.     Dim sText As String
    
18.     sText = ThisDrawing.Utility.GetString(0, "输入标高值: ")
    
19.     If sText = "" Then Exit Sub
    
20.     Dim iPt As Variant
    
21.     iPt = ePt
    
22.     Dim TextObj As AcadText
    
23.     Set TextObj = ThisDrawing.ModelSpace.AddText(sText, iPt, ThisDrawing.GetVariable("TEXTSIZE"))
    
24.     TextObj.GetBoundingBox sPt, ePt '用于计算文本长度
    
25.     iPt = ThisDrawing.Utility.PolarPoint(iPt, 0, (ePt(0) - sPt(0)) / 2 + 1)
    
26.     iPt = ThisDrawing.Utility.PolarPoint(iPt, 3.1415927 / 2, 1) '设置文本与线的间隔为1mm
    
27.     TextObj.Alignment = acAlignmentBottomCenter
    
28.     TextObj.TextAlignmentPoint = iPt
    
29.     pPt(6) = pPt(4) + ePt(0) - sPt(0) + 2: pPt(7) = pPt(5)
    
30.     Dim lwpLineObj As AcadLWPolyline
    
31.     Set lwpLineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(pPt)
    
32.     lwpLineObj.SetWidth 0, 0, 1 '设置箭头的大小
    
33. End Sub
    
34. 
    
35.   [/FONT]
    

<br />   [FONT=courier new]<br /> Sub Test()<br />     On Error Resume Next<br />     Dim pPt(0 To 7) As Double<br />     Dim sPt As Variant<br />     sPt = ThisDrawing.Utility.GetPoint(, "指定起点: ")<br />     If Err Then Exit Sub<br />     pPt(0) = sPt(0): pPt(1) = sPt(1)<br />     Dim ePt As Variant<br />     ePt = ThisDrawing.Utility.GetPoint(sPt, "指定终点: ")<br />     If Err Then Exit Sub<br />     sPt = ThisDrawing.Utility.PolarPoint(sPt, ThisDrawing.Utility.AngleFromXAxis(sPt, ePt), 2.5) '用于设置箭头长度<br />     pPt(2) = sPt(0): pPt(3) = sPt(1)<br />     pPt(4) = ePt(0): pPt(5) = ePt(1)<br />     Dim sText As String<br />     sText = ThisDrawing.Utility.GetString(0, "输入标高值: ")<br />     If sText = "" Then Exit Sub<br />     Dim iPt As Variant<br />     iPt = ePt<br />     Dim TextObj As AcadText<br />     Set TextObj = ThisDrawing.ModelSpace.AddText(sText, iPt, ThisDrawing.GetVariable("TEXTSIZE"))<br />     TextObj.GetBoundingBox sPt, ePt '用于计算文本长度<br />     iPt = ThisDrawing.Utility.PolarPoint(iPt, 0, (ePt(0) - sPt(0)) / 2 + 1)<br />     iPt = ThisDrawing.Utility.PolarPoint(iPt, 3.1415927 / 2, 1) '设置文本与线的间隔为1mm<br />     TextObj.Alignment = acAlignmentBottomCenter<br />     TextObj.TextAlignmentPoint = iPt<br />     pPt(6) = pPt(4) + ePt(0) - sPt(0) + 2: pPt(7) = pPt(5)<br />     Dim lwpLineObj As AcadLWPolyline<br />     Set lwpLineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(pPt)<br />     lwpLineObj.SetWidth 0, 0, 1 '设置箭头的大小<br /> End Sub<br /> <br />   [/FONT]<br />

cj2000

谢谢回复。标高等于y坐标值。
只是想用在LT版的按钮上（按钮里的命令用），似乎最多能容纳200多个字符。

：：：：：：：：：：：：：：：：：：：：：：：：：：：：：：：：：
看来对LT是比较难办，autocad R版安装成功，将别人的LSP拿来用了
：：：：：：：：：：：：：：：：：：：：：：：：：：：：：：：：：

;*******************************************************************
;  错误处理
;*******************************************************************
(defun cof_err (s)
(princ (strcat "\nError: " s))
(setq *ERROR* old_err)
(if echo
  (setvar "CMDECHO" echo)
)
(if clay
  (setvar "CLAYER" clay)
)
(if old_osmode
  (setvar "OSMODE" old_osmode)
)
(princ)
)
;*******************************************************************
;  标高TXT（带指示线）
;*******************************************************************
(defun c:level_ltxt ()
(setq old_err *ERROR*)
(setq *ERROR* cof_err)
(setq old_osmode (getvar "OSMODE"))
(setq clay (getvar "CLAYER"))
(setq echo (getvar "CMDECHO"))
;单位显示
  (setq uni_h (getvar "DIMLFAC"))
  (if (= uni_h 1000)(setq uni_h 1))
;字符高
  (setq txt_h (getvar "DIMTXT"))
  (setq txt_h (* txt_h (getvar "DIMSCALE")))
;字符偏移
  (setq oft 2)
  (setq oft (* oft (getvar "DIMSCALE")))
;标高小数位数
  (if (= dec_n nil)
   (progn
    (setq old_dec_n 2)
   )
   (progn
    (setq old_dec_n dec_n)
   )
  )
  (prompt "\n小数位数：<")(princ old_dec_n)(princ ">")
  (setq dec_n (getint ""))
  (if (= dec_n nil)(setq dec_n old_dec_n))
;hft指定点
  (setq hft (getpoint "\n标高点："))
  (setvar "OSMODE" 0)
;hft取得点的坐标
  (setq hftx (nth 0 hft))
  (setq hfty (nth 1 hft))
  (setq hfty (* hfty uni_h))
  (setq hftyp (rtos hfty 2 dec_n))
;形式分支
  (if (= chp nil)
   (progn
    (setq old_chp 1)
   )
   (progn
    (setq old_chp chp)
   )
  )
  (prompt "\n指示线：无<1>,有<2> <")(princ old_chp)(princ ">")
  (setq chp (getint ""))
  (if (= chp nil)(setq chp old_chp))
  (if (= chp 2)
   (progn
    ;图层操作
    (setvar "CMDECHO" 0)
    (command "-layer" "M" "-leader" "")
    ;指示线
    (setq ldx (* (+ 1 (strlen hftyp)) txt_h))
    (setvar "CMDECHO" 1)
    (command "LINE" hft pause "")
    (setq lp2 (getvar "LASTPOINT"))
    (setq lp2x (nth 0 lp2))
    (setq lp2y (nth 1 lp2))
    ;方向点
    (setq muki_p (getpoint "\n方向点："))
    (setq muki_px (nth 0 muki_p))
    (if (< lp2x muki_px)
     (progn
      (setq p0 lp2)
      (setq ep (list (+ lp2x ldx) lp2y))
     )
     (progn
      (setq p0 (list (- lp2x ldx) lp2y))
      (setq ep lp2)
     )
    )
    (command "LINE" p0 ep "")
    (setq pn 1)
   )
   (progn
    (setq p0 hft)
    (setq pn 0)
   )
  )
  (setvar "CMDECHO" 0)
;字符位置
  (setq p0x (nth 0 p0))
  (setq p0y (nth 1 p0))
  (setq tg (* (getvar "DIMGAP") (getvar "DIMSCALE")))
  (setq tp (list (+ p0x (* chp txt_h)) (+ tg p0y)))
;图层操作-------------------------------------------------------
  (command "-layer" "M" "-txt" "")
;画标记---------------------------------------------------------
  ;(setq p0x (+ p0x (* pn txt_h)))
  ;(setq p0 (list p0x p0y))
  ;(setq p1x (- p0x (/ txt_h (sqrt 3))))
  ;(setq p1y (+ p0y txt_h))
  ;(setq p1 (list p1x p1y))
  ;(setq p2x (+ p0x (/ txt_h (sqrt 3))))
  ;(setq p2y p1y)
  ;(setq p2 (list p2x p2y))
  ;(command "PLINE" p0 p1 p2 "C")

;写文字-----------------------------------------------------
  (command "TEXT" tp txt_h 0 hftyp)
  (setvar "OSMODE" old_osmode)
  (setvar "CLAYER" clay)
  (setvar "CMDECHO" echo)
(princ)
)