[日积月累]：智能标高程序

yunlong3000 · 发表于 2003-11-5 14:57:57

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

;;*****************************************************************************
;;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)
)

fjw_ok · 发表于 2003-11-5 15:11:36

建议斑竹给奖励

yunlong3000 · 发表于 2003-11-15 10:51:07

谢谢斑竹fjw_ok 的支持，
以前见过不少画标高符号的程序，很多都是给出几个选项
让选择左上、左下、右上、右下，很不方便。有些还是直接
插入图块！
于是就编了这个小程序，希望对大家能有所帮助。

ydf7332462 · 发表于 2003-11-30 22:12:07

1 功能相当打开了 F8
2 怎样平行于斜的被标线？

无忧 · 发表于 2003-12-2 11:09:55

我觉得标高这个东西，文字和三角还是一个图块的好，不管移动还是删除的时候选取起来都比较方便啊。所以我不喜欢天正的标高，也不喜欢你的标高。我也做了一个对高度(其实是Y轴的值)敏感的标高，是用属性块的，自己觉得用起来比较方便，一直在用。

ydf7332462 · 发表于 2003-12-2 22:33:42

楼上也传上来号吗？

无忧 · 发表于 2003-12-3 22:03:26

这个文件。有什么建议请说说。

ydf7332462 · 发表于 2004-1-2 20:51:00

块方法满好，我画管线，需要有别：
1>F8,插入角为0度
2>pick point,回车插入角随线Line or Pline,方向随线
3>pick point后又pick point(不一定在线上），插入角随线Line or Pline，方向为1st & 2st
3>比例可设
4>给一选项，可标多线。
无忧可否帮忙

liujian166 · 发表于 2006-8-25 09:55:38

下了，感觉还是有点问题，要是能自动标高就好了

youfengliu · 发表于 2006-8-25 12:36:48

谢谢各位楼主的方法

busuanshou · 发表于 2007-6-9 01:17:30

这么好的程序又被顶起来了~这才使我有幸见到啊
刚好学学人家的思路！

TLHMQH · 发表于 2007-6-9 02:23:03

值得研究。

qbailing · 发表于 2007-6-14 09:18:39

我用天正的标高程序计算标高值，然后用自己画的标高符号，改起来有点麻烦，但好看，天正的标高符号太大了。

idook · 发表于 2007-10-13 23:48:16

我自己是用VBA的，自写了一个，自我感觉用起来还还好……

b336 · 发表于 2007-11-12 12:15:31

谢谢提供

账号		自动登录	找回密码
密码			立即注册

[日积月累]：智能标高程序

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子