设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › [LISP程序]：指定基点自动标高程自动区分左右向，能用， ...
返回列表 发新帖
查看: 1320|回复: 3

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

[复制链接]
kmdz
发表于 2009-1-9 17:04:47 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

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

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

×
;智能标高程序
(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)
                )
setq, setvar, scal

相关帖子

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

使用道具 举报

gcho
发表于 2009-6-29 19:56:21 | 显示全部楼层
楼主你好，先感谢你的分享（你这个里面的“基点高程”是很多同类程序所没有的），但是我试用后怎么出现如下错误代码，我是菜鸟，麻烦你帮我看看！

命令: bg

指定基点:
基点高程:100

输入比例:<100>

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

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

使用道具 举报

carrot1983
发表于 2009-6-30 21:36:50 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
也忒粗糙了。。。

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

  60.     ;;画标高线
  61.     (progn
  62.       (command "_.LINE" "_NON" PT "_NON" PT2 "")
  63.       (command "_.LINE" "_NON" PT1 "_NON" PT1_LEFT "")
  64.       (command "_.LINE" "_NON" PT1 "_NON" PT1_RIGHT "")
  65.       (command "_.LINE" "_NON" PT1_RIGHT "_NON" PT1_LEFT "")
  66.     )

  68.     ;;高程
  69.     (setq H_NEW (+ H_BASE (- (cadr PT) (cadr PT_BASE))))

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

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

使用道具 举报

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

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

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

GMT+8, 2024-11-22 08:53 , Processed in 0.429302 second(s), 37 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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