找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1318|回复: 3

[LISP程序]:指定基点自动标高程自动区分左右向,能用,编得有点粗糙

[复制链接]
发表于 2009-1-9 17:04:47 | 显示全部楼层 |阅读模式

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

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

×
;智能标高程序
(defun c:bg()
  (default_date)
        (setq p0 (getpoint "\n指定基点:"))
  (setq h0 (getreal "\n基点高程:"))
  (setq scal (getreal "\n输入比例:<100>"))
  (if (= scal nil) (setq scal 100))
  (setq xsw (getreal "\n输入小数保留位数:<3>"))
  (if (= xsw nil) (setq xsw 3))
  (setq p1 p0)
        (while (/= p1 nil)
          (resume_date)
                (setq
          p1 (getpoint "\n指定标注点:")
          dh (/ (- (cadr p1) (cadr p0)) scal)
                                h1 (+ h0 dh)
                )
                (change_date)
                (fh)
        )
)
;******************************************************************
(defun fh()
  (setq a (* 3 scal))
        (setq b (* 2.5 scal))
        (setq p01 (getpoint "\n指定标注位置:"))
        (setq p2 (list (car p01) (cadr p1)))
        (setq p3 (polar p2 (- (/ pi 2) 0.54042) 292))
        (setq p4 (polar p3 pi (* 3 scal)))
        (setq p5 (polar p2 pi (* 3 scal)))
        (setq p6 (polar p5 0 (* 18 scal)))
        (setq p7 (polar p2 0 (* 2.5 scal)))
        (setq p8 (polar p7 (/ pi 2) (* 0.5 scal)))
        (if (> (- (car p01) (car p1)) 0)
        (progn
        (command "line" p2 p3 p4 "c")
        (command "line" p5 p6 "")
        (command "text"  p8 (* 2.5 scal) 0 (rtos h1 2 xsw))
        )
        (if (< (- (car p01) (car p1)) 0)
        (progn
        (setq p5 (polar p2 0 (* 3 scal)))
        (setq p6 (polar p5 pi (* 18 scal)))
        (setq p7 (polar p6 0 (* 1 scal)))
        (setq p8 (polar p7 (/ pi 2) (* 0.5 scal)))
        (command "line" p2 p3 p4 "c")
        (command "line" p5 p6 "")
        (command "text"  p8 (* 2.5 scal) 0 (rtos h1 2 xsw))
        )
        )
)
)
;******************************************************************
(defun default_date()
         (setq dim_s (getvar "dimscale")   
          dim_a (getvar "dimasz")
          os_mode (getvar "osmode")
          plw (getvar "plinewid")
                                blip (getvar "blipmode")
          orth (getvar "orthomode"))
        )       
;******************************************************************       
(defun change_date()
    (setvar "dimscale" 100)
    (setvar "dimasz" (* 2.5 100))
    (setvar "osmode" 0)
    (setvar "plinewid" 30)
    (setvar "blipmode" 0)
         (setvar "orthomode" 0)
         (setvar "cmdecho" 0)
                )       
;******************************************************************               
(defun resume_date()
    (setvar "dimscale" dim_s)
    (setvar "dimasz" dim_a)
    (setvar "osmode" os_mode)
    (setvar "plinewid" plw)
    (setvar "blipmode" blip)
         (setvar "orthomode" orth)
         (setvar "cmdecho" 0)
                )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
发表于 2009-6-29 19:56:21 | 显示全部楼层
楼主你好,先感谢你的分享(你这个里面的“基点高程”是很多同类程序所没有的),但是我试用后怎么出现如下错误代码,我是菜鸟,麻烦你帮我看看!

命令: bg

指定基点:
基点高程:100

输入比例:<100>

输入小数保留位数:<3>2

指定标注点:
指定标注位置:; 错误: 参数类型错误: fixnump: 2.0
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2009-6-30 21:36:50 | 显示全部楼层
也忒粗糙了。。。

  1. ;;智能标高程序 By carrot1983 20090701
  2. (command "_.browser" "http://carrot1983.ys168.com/")
  3. (defun C:BG (/              ANG_H    ANG_V        D         D1          DIMZIN
  4.              H_BASE   H_NEW    POS_PT        PREC         PT          PT1
  5.              PT1_LEFT PT1_RIGHT                PT1_TOP         PT2          PT_BASE
  6.              PT_TEXT  SC
  7.             )
  8.   ;;初始设置
  9.   (progn
  10.     (setvar "CMDECHO" 0)
  11.     (command "_.UNDO" "_END")
  12.     (command "_.UNDO" "_BEGIN")
  13.     (setq DIMZIN (getvar "DIMZIN"))
  14.   )
  15.   ;;用户输入
  16.   (progn
  17.     (setq SC (getreal "\n输入比例<100>: "))
  18.     (if        (null SC)
  19.       (setq SC 100)
  20.     )
  21.     (setq PREC (getint "\n输入标高精度(保留小数位数)<3>: "))
  22.     (if        (null PREC)
  23.       (setq PREC 3)
  24.     )
  25.     (setq H_BASE (getreal "\n输入基点高程<0.000>: "))
  26.     (if        (null H_BASE)
  27.       (setq H_BASE 0.000)
  28.     )
  29.     (setq PT_BASE (getpoint "\n指定基点<0,0,0>: "))
  30.     (if        (null PT_BASE)
  31.       (setq PT_BASE '(0 0 0))
  32.     )
  33.   )
  34.   (while (and (setq PT (getpoint PT_BASE "\n指定标注点<退出>: "))
  35.               (not (initget 32))
  36.               (setq POS_PT (getpoint PT "\n指定标高位置<退出>: "))
  37.          )
  38.     ;;计算点位
  39.     (progn
  40.       (setq D (* 3 SC))
  41.       (setq D1 (* 2.5 SC))
  42.       ;;标高方向
  43.       (setq ANG_H (angle PT (list (car POS_PT) (cadr PT))))
  44.       (setq ANG_V (angle PT (list (car PT) (cadr POS_PT))))
  45.       (if (= ANG_V 0.0)
  46.         (setq ANG_V (* 0.5 pi))
  47.       )
  48.       ;;标高线点位
  49.       (setq PT1 (polar PT ANG_H D)) ;_三角顶点
  50.       (setq PT1_TOP (polar PT1 ANG_V D1))
  51.       (setq PT1_RIGHT (polar PT1_TOP ANG_H (* 0.5 D)))
  52.       (setq PT1_LEFT (polar PT1_RIGHT (+ ANG_H pi) D))
  53.       (setq PT2 (polar PT ANG_H (* 18 SC))) ;_引线端点
  54.       ;;标高文字基点
  55.       (setq PT_TEXT (polar (polar PT1 ANG_H D1) ANG_V (* 0.5 SC)))
  56.     )

  57.     ;;画标高线
  58.     (progn
  59.       (command "_.LINE" "_NON" PT "_NON" PT2 "")
  60.       (command "_.LINE" "_NON" PT1 "_NON" PT1_LEFT "")
  61.       (command "_.LINE" "_NON" PT1 "_NON" PT1_RIGHT "")
  62.       (command "_.LINE" "_NON" PT1_RIGHT "_NON" PT1_LEFT "")
  63.     )

  64.     ;;高程
  65.     (setq H_NEW (+ H_BASE (- (cadr PT) (cadr PT_BASE))))

  66.     (setvar "DIMZIN" 0) ;_消零处理
  67.     (setq TXT (rtos H_NEW 2 PREC))
  68.     (setvar "DIMZIN" DIMZIN)
  69.     ;;四个象限
  70.     (cond ((and (equal ANG_H 0.0) (equal ANG_V (* 0.5 pi)))
  71.            (command "_.TEXT" "_NON" PT_TEXT D1 0 TXT)
  72.           )
  73.           ((and (equal ANG_H pi) (equal ANG_V (* 0.5 pi)))
  74.            (command "_.TEXT" "J" "R" "_NON" PT_TEXT D1 0 TXT)
  75.           )
  76.           ;;以下两种情况不懂的算不算符合制图规范 [算全面的练习吧]。
  77.           ((and (equal ANG_H pi) (equal ANG_V (* 1.5 pi)))
  78.            (command "_.TEXT" "J" "TR" "_NON" PT_TEXT D1 0 TXT)
  79.           )
  80.           ((and (equal ANG_H 0.0) (equal ANG_V (* 1.5 pi)))
  81.            (command "_.TEXT" "J" "TL" "_NON" PT_TEXT D1 0 TXT)
  82.           )
  83.     )
  84.     (setq PT_BASE PT)
  85.     (setq H_BASE H_NEW)
  86.   )
  87.   (command "_.UNDO" "_END")
  88.   (princ)
  89. )

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2009-7-10 22:49:46 | 显示全部楼层
希望能完善,我等着用你的成果哦!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-11-15 01:46 , Processed in 0.164619 second(s), 37 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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