设为首页收藏本站

晓东CAD家园-论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1538|回复: 8

[求助] 现有复制标高能增加标高数值,如何实现拉伸或者移动标高同样可以改变标高数值?请赐教

[复制链接]
发表于 2013-4-19 10:24:03 | 显示全部楼层 |阅读模式

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

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

x
[pcode=lisp,true];;复制标高,标高数字自动修改
(defun c:jbg ()
  ;(PXT_ER)
  (defun DXF (n da) (cdr (assoc n da)))
  (setq        xtblm '("osmode" "clayer" "cecolor" "orthomode" "plinewid")
        xtblz (mapcar 'getvar xtblm)
  )
  (setvar "osmode" 1) ;_捕捉端点  
  (princ "\n请选择要复制\"图层为_B标高\"的标高(退出):")
;;;  (setq        ss (ssget ":L"
;;;                  (list (cons 8 "B标高"))
;;;           )
;;;  )
  (setq ss (ssget))
  (if ss
    (progn
      (command "undo" "be")
      (if (null bl-cb)
        (setq bl-cb 1.0)
      )
      (prompt (strcat "\n当前缩放比例:【" (rtos bl-cb 2 1) "】"))
      (initget "Bili")
      (setq p1 (getpoint "\nBili改变比例/ 基点(退出):"))
      (while (= p1 "Bili")
        (setq
          bl-cb2
           (getreal (strcat "\n请输入比例:<" (rtos bl-cb 2 1) ">")
           )
        )
        (if bl-cb2
          (setq bl-cb bl-cb2)
          (setq bl-cb bl-cb)
        )
        (prompt (strcat "\n当前缩放比例:【" (rtos bl-cb 2 1) "】"))
        (initget "Bili")
        (setq p1 (getpoint "\nBili改变比例/ 基点(退出):"))
      )
      ;;--------------------------------------------  
      (setvar "osmode" 673) ;_捕捉端点、交叉点、最近点 垂足
      (while (setq p2 (getpoint p1 "\n拷贝至 (退出): "))
        ;;-------------------------------
        ;; 返回复制后,新生成的物体ss_new
        (setq en_Last (entlast)
              ss_new  (ssadd)
        )
        (command "copy" ss "" p1 p2)
        (setq en_next (entnext en_Last))
        (while en_next
          (ssadd en_next ss_new)
          (setq en_next (entnext en_next))
        )
        ;;------------------------------
        (setq i 0)
        (repeat        (sslength ss_new)
          (setq        en   (ssname ss_new i)
                da   (entget en)
                enty (DXF 0 da)
          )
          (cond
            ;;处理:普通标高text 天正标高
            ((member enty (list "TEXT" "TCH_ELEVATION"))
             (setq txt (DXF 1 da))
             (if (or (= txt "%%p0.000")
                     (= txt "0") ;_Tch标高为 (1 . "0")
                     (and (/= (atof txt) 0)
                          (wcmatch txt "*.*")
                     )
                 )
               (progn
                 ;;--计算高差----
                 (setq d   (- (cadr p2) (cadr p1))
                       d   (* d 0.001 bl-cb)
                       num (+ (atof txt) d)
                 )
                 (setq txt-n (rtos num 2 3))
                 (if (= txt-n "0.000")
                   (setq txt-n "%%p0.000")
                 )
                 ;;-------------
                 (setq da (subst (cons 1 txt-n) (assoc 1 da) da))
                 (entmod da)
               )
             )
            )
            ;;处理:属性标高
            ((member enty (list "INSERT"))
             (setq da  (entget (entnext en))
                   txt (DXF 1 da)
             )
             ;;--计算高差----
             (setq d   (- (cadr p2) (cadr p1))
                   d   (* d 0.001 bl-cb)
                   num (+ (atof txt) d)
             )
             (setq txt-n (rtos num 2 3))
             (if (= txt-n "0.000")
               (setq txt-n "%%p0.000")
             )
             ;;-------------
             ;;============================
             ;; 替换属性文字
             (setq da (entget (entnext en)))
             (setq da (subst (cons 1 txt-n) (assoc 1 da) da))
             (entmod da)
             (entupd en)
             (entupd (entnext en))
             ;;============================
            )
          ) ;_ cond
          (setq i (1+ i))
        ) ;_end repeat
      ) ;_end while
      (command "undo" "e")
    )
  ) ;_ if ss
  (mapcar 'setvar xtblm xtblz)
  (princ)
)[/pcode]
以上是网络上寻找到的复制标高同时能增加标高数值的源码(感谢原作者),现有复制标高能增加标高数值,如何实现拉伸或者移动标高同样可以改变标高数值?请赐教
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
 楼主| 发表于 2013-4-19 10:30:45 | 显示全部楼层
那个表情是英文L,哈哈
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

点击这里给我发消息

已领礼包: 145个

财富等级: 日进斗金

发表于 2013-4-19 10:35:21 | 显示全部楼层
发代码时候请用 代码 标签。 右侧禁止表情符号。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

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

使用道具 举报

 楼主| 发表于 2013-4-20 14:45:08 | 显示全部楼层
气氛好差,晓东要想恢复尚需时日;P
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2013-4-20 14:50:14 | 显示全部楼层
实现途径
1 用反应器(参看论坛的敏感标高)
2 用专用命令
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

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

使用道具 举报

 楼主| 发表于 2013-4-23 19:05:30 | 显示全部楼层
每天来一次;P
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2013-4-26 07:33:35 | 显示全部楼层
今天继续;P
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2020-9-26 23:56 , Processed in 0.182852 second(s), 64 queries , Gzip On, WinCache On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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