[编程申请]：动态标高标注

dingnt

动态标高标注的程序有不少,大多是水平的.曾见过有带角度的,就是如果标注的基线是有角度的,标注符号也同一角度,但不用旋转UCS做的,不知哪位知道这是如何实现的

Dream.Fei

那照你这样说,你在绘标高的时候岂不是要点二下才能输入标高?

dingnt

那个程序运行是这样的:首先是标注点(空白点或任意角度的直线),图中动态显示标高符号,不同象限不一样.由用户输入标高值,点确定完成标注

coco25825

看看这个

;;*****************************************************************************
;;YL_begin
;;功 能：绘图程序的初始化处理，记录当前层名、线型、颜色、捕捉方式、文本样式、文本高度,
;; 控制点标记可见方式、主单位值消零处理方式、命令行回显方式、然后关闭目标捕捉,
;; 设置线形随层、颜色随层、设置命令行不回显、不显示控制点标记、对主单位值后续零作消零处理
;;说 明：和函数YL_end配对使用。
(defun YL_begin ()
(setq oderr *error*) ;;保存原来的*error*
(setq *error* YL_err) ;;将*error*用自己的错误处理函数替代
(setq odltp (getvar "celtype")) ;;记录当前线型设置
(setq odclr (getvar "cecolor")) ;;记录当前颜色设置
(setq odosm (getvar "osmode")) ;;记录当前捕捉方式
(setq odlay (getvar "clayer")) ;;记录当前层
(setq odsty (getvar "textstyle")) ;;记录当前文本样式
(setq odtsz (getvar "textsize")) ;;记录当前文本高度
(setq odbpm (getvar "blipmode")) ;;记录当前控制点标记是否可见
(setq odzin (getvar "dimzin")) ;;记录主单位值消零处理方式
(setq odcmd (getvar "cmdecho")) ;;记录命令行回显方式
(setvar "celtype" "bylayer") ;;设置线形随层
(setvar "cecolor" "bylayer") ;;设置颜色随层
(setvar "cmdecho" 0) ;;设置命令行不回显
(setvar "blipmode" 0) ;;不显示控制点标记
(setvar "dimzin" 8) ;;对主单位值后续零作消零处理,因为DIMZIN 对 AutoLISP rtos 和 angtos 函数执行实数向字符串转换操作有影响。
(setvar "osmode" 0) ;;关闭对象捕捉方式
)

;;*****************************************************************************
;;YL_end
;;功 能：程序结束，恢复程序开始前的设置。
;; 恢复YL_begin设置的系统变量表中的数值。
;;说 明：和函数YL_begin配对使用。
(defun YL_end ()
(setvar "celtype" odltp)
(setvar "cecolor" odclr)
(setvar "osmode" odosm)
(setvar "textstyle" odsty)
(setvar "textsize" odtsz)
(setvar "blipmode" odbpm)
(setvar "dimzin" odzin) ;;恢复主单位值消零处理方式
(command "layer" "s" odlay "")
(setvar "cmdecho" odcmd)
(setq *error* oderr) ;;恢复原来的*error*
(princ)
)

;;*****************************************************************************
;;YL_err
;;功 能：错误处理函数。
(defun YL_err (msg)
(princ (strcat "\n错误:" msg "\n")) ;;打印错误原因
(YL_end) ;;调用函数YL_end恢复程序开始前的设置
(setq *error* oderr) ;;恢复原来的*error*
(princ)
)

;******************************************************************************
;;智能标高程序 BG
;;功 能：按比例绘制对高度敏感的标高符号
;; 其位置和方向能根据用户指定的点来确定。
;;作 者：yunlong3000

(defun c:BG (/ odscal scal pt dx dy ptb dxb dyb signx signy
ptt txt pt0 pt1 pt2 pt3 pt4 pt5 loopmk
)
(YL_begin) ;;初始化处理
(princ "\n按比例绘制对高度敏感的标高符号程序!")
(setq odscal (getvar "USERR1")) ;;取系统变量"USERR1"的值为默认比例因子
(if (equal odscal 0.0 0.1) ;;如果系统变量的值为0.0(容许误差为0.1)
(progn ;;则设置
(setq odscal 100.0) ;;首次运行,设默认比例因子为100
(setvar "USERR1" odscal) ;;系统变量userr1存储默认比例因子
)
)
(if (not (tblsearch "layer" "Fline")) ;;判断是否存在Fline层,无则创建。Fline指细实线
(command "layer" "m" "Fline" "c" "6" "" "l" "continuous" "" "")
)
(if (not (tblsearch "layer" "Text")) ;;判断是否存在Text层,无则创建
(command "layer" "m" "Text" "c" "3" "" "l" "continuous" "" "")
)
(if (not (tblsearch "style" "sty_YL")) ;;判断是否存在sty_YL字体,无则创建
(command"style" "sty_YL" "romans,hztxt" 0 0.7 0 "n" "n" "n")
)
(setq scal odscal) ;;比例取默认值
(setq loopmk T)
(while loopmk
(setvar "osmode" 16383) ;;设置对象捕捉方式为全部
(initget "S") ;;定义关键字
(setq pt (getpoint "\n S_比例/<输入标注点>:"))
(setvar "osmode" 0) ;;设置对象捕捉式无
(cond
((= pt nil) (setq loopmk nil))
((= pt "S") ;;比例因子
(setq scal (getreal (strcat "\n 请输入比例因子<" (rtos odscal) ">:")))
(if (= scal nil) (setq scal odscal)) ;;如果用户直接回车，则使用默认的比例值
(setq odscal scal)
)
(T
(setq dx (car pt))
(setq dy (cadr pt))
(setvar "osmode" 16383) ;;设置对象捕捉方式为全部
(setq ptb (getpoint pt "\n请指定点以确定标高符号所在的位置和方向："))
(setvar "osmode" 0) ;;设置对象捕捉方式无
(if (= ptb nil) exit) ;;如果没有给出点则退出程序
(setq dxb (car ptb))
(setq dyb (cadr ptb))
(if (< dxb dx) (setq signx -1) (setq signx 1))
(if (< dyb dy) (setq signy -1) (setq signy 1))
(if (< dxb dx)
(setq ptt (list (+ dxb (* 0.85 scal signx)) (+ dy (* 0.2 scal signy))))
(setq ptt (list (+ dxb (* 0.04 scal signx)) (+ dy (* 0.2 scal signy))))
)
(if (< dyb dy)
(setq ptt (polar ptt (* pi 1.5) (* 0.25 scal)))
)
(setq pt0 (list (+ dxb (* 0 scal signx)) (+ dy (* 0 scal signy))))
(setq pt1 (list (+ dxb (* 0.16 scal signx)) (+ dy (* 0.16 scal signy))))
(setq pt2 (list (- dxb (* 0.16 scal signx)) (+ dy (* 0.16 scal signy))))
(setq pt3 (list (+ dxb (* 0.85 scal signx)) (+ dy (* 0.16 scal signy))))
(setq pt4 (list (- dxb (* 0.16 scal signx)) (+ dy (* 0 scal signy))))
(setq pt5 (list (+ dxb (* 0.16 scal signx)) (+ dy (* 0 scal signy))))
(command "layer" "s" "Fline" "")
(command "pline" pt1 "w" "0" "0" pt0 pt2 pt3 "")
(command "line" pt4 pt5 "")
(setq txt (getstring (strcat "\n请输入标高值<" (rtos (/ dy 100) 2 3) ">:")))
(cond ((wcmatch txt "") (setq txt (rtos (/ dy 100) 2 3))))
(command "layer" "s" "Text" "")
(setvar "textstyle" "sty_YL")
(command "text" ptt (* 0.25 scal) 0 txt )
)
)
)
(setvar "USERR1" scal) ;;系统变量userr1存储默认比例因子
(YL_end) ;;恢复程序开始前的设置
(princ "\n绘制完成!")
(princ)
)

;|
LPMBG.lsp 立剖面标高
* C:LPMBG
-- XYP@bsedi.com
2004.11.14
|;
(prompt "\n\r      加载立剖面标高程序。")
;;;-------------------------------------------
;;;主程序
(DEFUN C:LPMBG (/ pt1 x x1 dy)
  (CMDLA0)
  (command ".undo" "BE")
  (MKLA "biaogao" 3)   
  (setq    txt5 (@ukword 1 "1 2 3 4 5" "\n请选择形式：1-右标高/2-左标高/3-剖面标高/4-设出图比例/5-设±0.000基点" txt5))
  (while (or (= txt5 "5")(NULL PT0))(@jidian)
    (setq txt5 (@ukword 1 "1 2 3 4 5" "\n请选择形式：1-右标高/2-左标高/3-剖面标高/4-设出图比例/5-设±0.000基点" txt5))
    )
  (while (or (= txt5 "4")(NULL SC))(@setbl1)
    (setq txt5 (@ukword 1 "1 2 3 4 5" "\n请选择形式：1-右标高/2-左标高/3-剖面标高/4-设出图比例/5-设±0.000基点" txt5))
    )
  (if (= txt5 "3")(@sec))
  (if (or (= txt5"1")(= txt5"2"))
    (progn
      (while
    (SETQ pt1 (getpoint pt0 "\n\t标高位置点<退出> : "))
    (setq x (- (cadr pt1) (cadr pt0))
      x1 (* (/ x 1000) (GETVAR "DIMLFAC"))
      dy (rtos x1 2 3)
       )
    (if (= txt5 "2")(@bgleft))
    (if (= txt5 "1")(@bgright))
    )))
  (command ".undo" "E")
  (CMDLA1)
)
;;;-------------------------------------------
;;;子程序
;;;±0.000基点
(defun @jidian()
  (WHILE (NOT (SETQ pt0 (getpoint "\n\t确定±0.000标高点 : "))))
  )
;;;左标高
(defun @bgleft()
  (if    (= X 0)
      (command "INSERT" "$BG-L" pt1 SC SC "0" "±0.000")
      (command "INSERT" "$BG-L" pt1 SC SC "0" dy)
    )
  )
;;;右标高
(defun @bgright()
  (if    (= X 0)
      (command "INSERT" "$BG-R" pt1 SC SC "0" "±0.000")
      (command "INSERT" "$BG-R" pt1 SC SC "0" dy)
    )
  )
;;;剖面标高
(defun @sec()
  (setq H-ceng (ureal 1 "" "层高(m)" h-ceng))
  (setq n-ceng (ureal 1 "" "层数" n-ceng))
  (setvar "osmode"0)
  (command "ucs" "o" pt0)
  (setq y0 0 n 0 pt0 (list 0 0))
  (while (< n (+ 1 n-ceng))
    (setq y (* (/ y0 1000.0) (GETVAR "DIMLFAC"))
      y (rtos y 2 3)
      )
    (if    (= y0 0)
      (command "INSERT" "$BG-R" pt0 SC SC "0" "±0.000")
      (command "INSERT" "$BG-R" pt0 SC SC "0" y)
    )
    (setq n (+ 1 n))
    (setq y0 (* n 1000.0 h-ceng))
    (setq pt0 (list 0 y0))
  )
  (command "ucs" "")
  ;(exit)
)
;;;-------------------------------------------
;;;通用子程序
;;;
(defun CMDLA0 ()
  (setq cmdech (getvar "CMDECHO"))
  (setq oom (getvar "orthomode"))
  (setq osm (getvar "osmode"))
  (SETQ LA (getvar "clayer"))
  (setq rmode (getvar "regenmode"))
  (setq pw (getvar "plinewid"))
  (setvar "regenmode" 0)
  (setvar "CMDECHO" 0)
  (princ)
)

;;;
(defun CMDLA1 ()
  (setvar "CMDECHO" cmdech)
  (setvar "orthomode" oom)
  (setvar "osmode" osm)
  (setvar "clayer" LA)
  (setvar "regenmode" rmode)
  (setvar "plinewid" pw)
  (princ)
)

;;;图层输入格式化
(Defun MKLA (a b)
  (If (= (Tblsearch "layer" a) nil)
    (Command "layer" "m" a "c" b a "")
    (Command "layer" "t" a "s" a "c" b a "")
  )
)

;;;
(defun @ukword (bit kwd msg def / inp)
  (if (and def (/= def ""))
    (setq msg (strcat "\n" msg "<" def ">:")
      bit (* 2 (fix (/ bit 2)))
    )
    (setq msg (strcat "\n" msg ":"))
  )
  (initget bit kwd)
  (setq inp (getkword msg))
  (if inp
    inp
    def
  )
)
;;;数字格式化输入
(defun @ureal (bit kwd msg def / inp)
  (if def
    (setq msg (strcat "\n" msg "<" (rtos def 2) ">: ")
      bit (* 2 (fix (/ bit 2)))
    )
    (setq msg (strcat "\n" msg ": "))
  )
  (initget bit kwd)
  (setq inp (getreal msg))
  (if inp
    inp
    def
  )
)

;;;出图比例
(defun @setbl1 ()
  (setq bl (@ureal 1 "" "\n输入出图比例1 : " bl)    SC (/ bl 100))
  (command "modemacro" (strcat "XCAD BY XYP." " 当前出图比例 1:" (rtos bl 2 1)))
)

;;;
(DEFUN PXYP (TXT1)
  (SETQ    TXT1 (STRCAT "\n\r      程序命令: " TXT1 "      -- xyp@bsedi.com"))
  (PRINC TXT1)
  (Princ)
)

;;;
(pxyp "LPMBG      (立剖面标高)")
(princ)
;;;-------------------------------------------
;;;END