[LISP程序]：修改尺寸标注为楼梯标注形式（实用程序）

paladi · 发表于 2009-8-21 01:18:32

楼主，支持小数不啊，暂时下不下来，先了解下。

gysjy · 发表于 2009-8-21 08:05:15

不支持小数。楼梯尺寸不需要精确到小数。

paladi · 发表于 2009-8-21 16:42:38

楼主，我提个建议，能不能修改下啊，要是能选择精确度就好了，这样就可以在别的地方使用了。

gysjy · 发表于 2009-8-21 21:39:23

哦，你想在别的什么地方用呢？

paladi · 发表于 2009-8-22 00:45:54

比如踏步高啊，我们以前画的踏步高就带了一位小数。主要是想精确一点，如果带点小数，不至于相乘的总数离实际数差太多。可以吗，楼主。

gysjy · 发表于 2009-8-22 19:48:37

我还是难以想象，踏步高要带小数。踏步尺寸标注精确到毫米，如果带小数就是精确到丝米了，有这样精确的建筑工程吗？

paladi · 发表于 2009-8-23 02:17:36

楼主，其实不是工程精确到小数，而是图上标识精确到小数，只是为了相乘的得数可以跟总数更接近。

gysjy · 发表于 2009-8-24 12:22:28

最初由 paladi 发布
[B]比如踏步高啊，我们以前画的踏步高就带了一位小数。主要是想精确一点，如果带点小数，不至于相乘的总数离实际数差太多。可以吗，楼主。 [/B]

以下程序踏步宽或高可以精确到一位小数：
[PHP](princ "\n修改尺寸标注为楼梯标注形式，\n比例为1：50，请执行ltdim；\n比例为1：100，请执行ltdim1。")
(defun c:ltdim(/ ss nn ssl n sn en p1 p2 dis3 dis0 t0 t1 t b m bs ms dis00 str)
;;全局变量: wxn0
(setq  *error* nil)
(command "undo" "g")
(setvar "cmdecho" 0)
(setq ss (ssget))
(if (= wxn0 nil) (setq wxn0 260))
(princ "\n步长或步数<") (princ wxn0)
(setq nn (getint ">:"))
(if (= nn nil) (setq nn wxn0))
   (setq ssl (sslength ss) n 0)
   (repeat ssl
   (setq sn (ssname ss n) en (entget sn) n (1+ n))
   (if (= "DIMENSION" (cdr (assoc 0 en)))
      (progn
         (setq p1 (cdr (assoc 13 en)) p2 (cdr (assoc 14 en))
               dis3 (distance p1 p2) dis0 (* 0.5 dis3)
               t0 (/ dis3 nn)  t(/ t0 2)
         )
         (if (> nn t) (setq b nn m t bs (itoa b))
            (setq m nn b t bs (rtos b 2 1))
         )
         (setq ms (rtos m 2 0)  diss0 (rtos dis0 2 0))
         (setq str (strcat bs "X" ms "=" diss0))
         (command "dim1" "newtext" str  sn "")
         (setq wxn0 nn)
      )
   )
   (princ (strcat str "; "))
   )
   (command "undo" "e")
   (princ "\n          gysjy0  96.8制作, 09.8修改.")
   (princ)
)

(defun c:ltdim1(/ ss nn ssl n sn en p1 p2 dis3 dis0 t0 t1 t b m bs ms dis00 str)
;;全局变量: wxn0
(setq  *error* nil)
(command "undo" "g")
(setvar "cmdecho" 0)
(setq ss (ssget))
(if (= wxn0 nil) (setq wxn0 260))
(princ "\n步长或步数<") (princ wxn0)
(setq nn (getint ">:"))
(if (= nn nil) (setq nn wxn0))
   (setq ssl (sslength ss) n 0)
   (repeat ssl
   (setq sn (ssname ss n) en (entget sn) n (1+ n))
   (if (= "DIMENSION" (cdr (assoc 0 en)))
      (progn
         (setq p1 (cdr (assoc 13 en)) p2 (cdr (assoc 14 en))
               dis3 (distance p1 p2) dis0 dis3
               t (/ dis3 nn)
         )
         (if (> nn t) (setq b nn m t bs (itoa b))
            (setq m nn b t bs (rtos b 2 1))
         )
         (setq ms (rtos m 2 0)  diss0 (rtos dis0 2 0))
         (setq str (strcat bs "X" ms "=" diss0))
         (command "dim1" "newtext" str  sn "")
         (setq wxn0 nn)
      )
   )
   (princ (strcat str "; "))
   )
   (command "undo" "e")
   (princ "\n          gysjy0  96.8制作, 09.8修改.")
   (princ)
)[/PHP]

paladi · 发表于 2009-8-25 14:07:00

楼主，怎么用不起啊，一输入命令就显示“incorrect object to bind: T”

gysjy · 发表于 2009-8-25 22:17:19

将程序中所有的变量t改为t0：
[PHP](princ "\n修改尺寸标注为楼梯标注形式，\n比例为1：50，请执行ltdim；\n比例为1：100，请执行ltdim1。")
(defun c:ltdim( / b bs dis0 dis3 en m ms n nn p1 p2 sn ss ssl str t0)
;;全局变量: wxn0
(setq  *error* nil)
(command "undo" "g")
(setvar "cmdecho" 0)
(setq ss (ssget))
(if (= wxn0 nil) (setq wxn0 260))
(princ "\n步长或步数<") (princ wxn0)
(setq nn (getint ">:"))
(if (= nn nil) (setq nn wxn0))
   (setq ssl (sslength ss) n 0)
   (repeat ssl
   (setq sn (ssname ss n) en (entget sn) n (1+ n))
   (if (= "DIMENSION" (cdr (assoc 0 en)))
      (progn
         (setq p1 (cdr (assoc 13 en)) p2 (cdr (assoc 14 en))
               dis3 (distance p1 p2) dis0 (* 0.5 dis3)
               t0 (/ dis3 nn)  t0 (/ t0 2)
         )
         (if (> nn t0) (setq b nn m t0 bs (itoa b))
            (setq m nn b t0 bs (rtos b 2 1))
         )
         (setq ms (rtos m 2 0)  diss0 (rtos dis0 2 0))
         (setq str (strcat bs "X" ms "=" diss0))
         (command "dim1" "newtext" str  sn "")
         (setq wxn0 nn)
      )
   )
   (princ (strcat str "; "))
   )
   (command "undo" "e")
   (princ "\n          gysjy0  96.8制作, 09.8修改.")
   (princ)
)

(defun c:ltdim1( / b bs dis0 dis3 en m ms n nn p1 p2 sn ss ssl str t0)
;;全局变量: wxn0
(setq  *error* nil)
(command "undo" "g")
(setvar "cmdecho" 0)
(setq ss (ssget))
(if (= wxn0 nil) (setq wxn0 260))
(princ "\n步长或步数<") (princ wxn0)
(setq nn (getint ">:"))
(if (= nn nil) (setq nn wxn0))
   (setq ssl (sslength ss) n 0)
   (repeat ssl
   (setq sn (ssname ss n) en (entget sn) n (1+ n))
   (if (= "DIMENSION" (cdr (assoc 0 en)))
      (progn
         (setq p1 (cdr (assoc 13 en)) p2 (cdr (assoc 14 en))
               dis3 (distance p1 p2) dis0 dis3
               t0 (/ dis3 nn)
         )
         (if (> nn t0) (setq b nn m t0 bs (itoa b))
            (setq m nn b t0 bs (rtos b 2 1))
         )
         (setq ms (rtos m 2 0)  diss0 (rtos dis0 2 0))
         (setq str (strcat bs "X" ms "=" diss0))
         (command "dim1" "newtext" str  sn "")
         (setq wxn0 nn)
      )
   )
   (princ (strcat str "; "))
   )
   (command "undo" "e")
   (princ "\n          gysjy0  96.8制作, 09.8修改.")
   (princ)
)[/PHP]

paladi · 发表于 2009-8-26 09:40:54

谢谢楼主，这下可以用了，以后可以用来标楼梯还可以用来等分尺寸了。非常方便。谢谢～～

pop159 · 发表于 2009-12-5 23:23:03

非常实用，每次都要很麻烦的去修改尺寸，这下就方便了，谢

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