明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2549|回复: 3

断面标注

[复制链接]
发表于 2011-3-28 15:43:38 | 显示全部楼层 |阅读模式
本帖最后由 yjpzc 于 2011-4-15 14:36 编辑

(defun c:dmbz()
     (setvar "cmdecho" 0)
     (setq osmode_bak(getvar "osmode"))
     (setvar "osmode" 0)
     (command "layer" "M" "dmbz" "C" "7" "" "LT" "CONTINUOUS" "" "")
     (princ "比例尺:<1:")
     (princ scale)
     (princ ">")
     (setq scale1 (getreal))
     (if (not (null scale1)) (setq scale scale1))
     (setq zh (/ (* 2.5 scale) 1000))
     (setvar "luprec" 1)  
       (setq midxy(getpoint "\n请选择断面的中点:"))
       (setq midx(nth 0 midxy))
       (setq midy(nth 1 midxy))
       (setq midgc(getreal "\n请选择断面的中点高程:"))
       (setq pt1(getpoint "\n请选择标注断面的点:"))
       (while (/= pt1 nil)
              (setq bzx(nth 0 pt1))
              (setq bzy(nth 1 pt1))
              (setq s(strcat "偏距:" (rtos (abs(- midx bzx))2 3)))
              (setq h(strcat "高程:" (rtos (+ midgc (- bzy midy)) 2 3)))
              (setq pt2 (getpoint pt1 "输入引线"))
              (setq ang (angle pt1 pt2))
              (setq ang1 (* (/ ang pi) 180))
                 (xy2)
   
  (if
              (and (>= ang1 90) (<= ang1 270))
                    (xy1))
  (command "pline" pt1 pt2 pt3 "")
  (command "text" "j" "c"   pt5 zh 0 s)
  (command "text" "j" "c"  pt6 zh 0 h)
  (setq pt1 (getpoint "输入标注点 (右击取消)"))
  )
  (setvar "osmode" osmode_bak)
  )                 
              
              
              
              
发表于 2011-5-25 13:34:20 | 显示全部楼层
运行后出现     错误: no function definition: XY2
发表于 2019-5-23 23:23:50 | 显示全部楼层
小小改了下 将就用  

  1. (defun c:dmbz()
  2.      (setvar "cmdecho" 0)
  3.      (setq osmode_bak(getvar "osmode"))
  4.      (setvar "osmode" 1)
  5.      (command "layer" "M" "dmbz" "C" "7" "" "LT" "CONTINUOUS" "" "")
  6.      (princ "标注比例尺:<1:")
  7.      (princ scale)
  8.      (princ ">")
  9.      (setq scale1 (getreal))
  10.      (if (not (null scale1)) (setq scale scale1))
  11.      (setq zh (/ (* 2.5 scale) 1000))
  12.   (setq hxbl (getint "\n请输入断面横向比例 1 :"))
  13.   (setq zxbl (getint "\n请输入断面纵向比例 1 :"))
  14.      (setvar "luprec" 1)  
  15.        (setq midxy(getpoint "\n请选择断面的中点:"))
  16.        (setq midx(nth 0 midxy))
  17.        (setq midy(nth 1 midxy))
  18.        (setq midgc(getreal "\n请选择断面的中点高程:"))
  19.        (setq pt1(getpoint "\n请选择标注断面的点:"))
  20.        (while (/= pt1 nil)
  21.               (setq bzx(nth 0 pt1))
  22.               (setq bzy(nth 1 pt1))
  23.               (setq s(strcat "偏距:" (rtos    (* (abs(- midx bzx)) (/ hxbl 1000.000))      2 3)))
  24.               (setq h(strcat "高程:" (rtos (+ midgc  (*(- bzy midy) (/ zxbl 1000.000) )   ) 2 3)))
  25.               (setq pt2 (getpoint pt1 "输入引线"))
  26.               (setq ang (angle pt1 pt2))
  27.               (setq ang1 (* (/ ang pi) 180))

  28.       (defun xy2  ( /)
  29.        (setq pt5 (polar pt2 (+ (* pi 0.5 ) ang1) zh) ) (setq pt6 (polar pt2 (+ (* pi 1.5 ) ang1) zh) )
  30.       (setq pt3 (polar pt2 0 (* 5 zh)) )
  31.   )
  32.    (defun xy1  ( /)
  33.        (setq pt5 (polar pt2 (+ (* pi 1.5 ) ang1) zh) ) (setq pt6 (polar pt2 (+ (* pi 0.5 ) ang1) zh) )
  34.       (setq pt3 (polar pt2 0 (* 5 zh)) )
  35.   )
  36.    
  37.                  (xy2)
  38.    
  39.   (if
  40.               (and (>= ang1 90) (<= ang1 270))
  41.                     (xy1))

  42.   (command "pline" pt1 pt2 pt3 "")
  43.    (setvar "osmode" 16384)
  44.   ;(command "text" "j" "c"   pt5 zh 0 s)
  45.    (entmake (list '(0 . "TEXT") (cons 1 s) (cons 10 pt5) (cons 40 zh)))
  46.   ;(command "text" "j" "c"  pt6 zh 0 h)
  47.    (entmake (list '(0 . "TEXT") (cons 1 h) (cons 10 pt6) (cons 40 zh)))
  48.    (setvar "osmode" osmode_bak)
  49.   (setq pt1 (getpoint "输入标注点 (右击取消)"))
  50.   )
  51.   
  52.   )                 
  53.               
  54.               

发表于 2019-5-24 08:51:29 | 显示全部楼层
8年前的,要改就改好些啦
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-12-23 04:04 , Processed in 0.261191 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表