再贴个算钢筋的小程序

非ing · 发表于 2013-6-1 16:19:59

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

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

×

(defun c:gj (/) (setq gj_ggname (entget (car (entsel "\n钢筋规格"))))
(setq kk (entsel "\n钢筋长度"))
(if kk
(setq gj_cdname (entget (car kk))
gj_cd (atof (cdr (assoc 1 gj_cdname)))
)
(setq gj_cd (getreal "\n钢筋长度："))
)
(setq gj_gs (getreal "\n钢筋根数：")) ; _钢筋根数
(setq gj_zcname (entget (car (entsel))))
(setq gj_zlname (entget (car (entsel))))
(setq gj_gg (atof (cdr (assoc 1 gj_ggname)))) ; _规格
(setq gj_zc (atof (cdr (assoc 1 gj_zcname)))) ; _求钢筋总长
(setq gj_zl (atof (cdr (assoc 1 gj_zlname)))) ; _求钢筋重量
(setq gj_zcnr (* gj_cd gj_gs))
(setq gj_zcnrf (rtos (/ (* gj_cd gj_gs) 1000.0) 2 1))
(setq gj_zlnr (rtos (/ (* (* 0.00617 (expt gj_gg 2.0)) gj_zcnr) 1000.0) 2 1))
(setq gj_zcnrf (cons 1 gj_zcnrf))
(setq gj_zlnr (cons 1 gj_zlnr))
(setq gj_zc (subst
gj_zcnrf
(assoc 1 gj_zcname)
gj_zcname
)
)
(setq gj_zl (subst
gj_zlnr
(assoc 1 gj_zlname)
gj_zlname
)
)
(entmod gj_zc)
(entmod gj_zl)
(prin1)
)

(defun c:gj (/)  (setq gj_ggname (entget (car (entsel "\n钢筋规格")))) 
  (setq kk (entsel "\n钢筋长度")) 
  (if kk 
    (setq gj_cdname (entget (car kk)) 
          gj_cd (atof (cdr (assoc 1 gj_cdname))) 
    ) 
    (setq gj_cd (getreal "\n钢筋长度：")) 
  ) 
  (setq gj_gs (getreal "\n钢筋根数："))        ; _钢筋根数 
  (setq gj_zcname (entget (car (entsel)))) 
  (setq gj_zlname (entget (car (entsel)))) 
  (setq gj_gg (atof (cdr (assoc 1 gj_ggname))))        ; _规格 
  (setq gj_zc (atof (cdr (assoc 1 gj_zcname))))        ; _求钢筋总长 
  (setq gj_zl (atof (cdr (assoc 1 gj_zlname))))        ; _求钢筋重量 
  (setq gj_zcnr (* gj_cd gj_gs)) 
  (setq gj_zcnrf (rtos (/ (* gj_cd gj_gs) 1000.0) 2 1)) 
  (setq gj_zlnr (rtos (/ (* (* 0.00617 (expt gj_gg 2.0)) gj_zcnr) 1000.0) 2 1)) 
  (setq gj_zcnrf (cons 1 gj_zcnrf)) 
  (setq gj_zlnr (cons 1 gj_zlnr)) 
  (setq gj_zc (subst 
                gj_zcnrf 
                (assoc 1 gj_zcname) 
                gj_zcname 
              ) 
  ) 
  (setq gj_zl (subst 
                gj_zlnr 
                (assoc 1 gj_zlname) 
                gj_zlname 
              ) 
  ) 
  (entmod gj_zc) 
  (entmod gj_zl) 
  (prin1) 
)

非ing · 发表于 2013-6-1 16:23:08

;;;(entget (car (entsel)))
(defun C:er(/ ss)
(setq ss (ssget '((-4 . "<OR")(62 . 1) (0 . "INSERT")(-4 . "OR>"))))
(vl-cmdf "_erase" ss "")
)
(defun c:eco(/ ss)
(setq ss (ssget '((-4 . "<OR")(62 . 1) (0 . "INSERT")(-4 . "OR>"))));(0 . "LWPOLYLINE")
(vl-cmdf "_copy" ss "")
)

删除和复制

非ing · 发表于 2013-6-1 16:24:26

(defun sc(m /)
(setq ss (ssget '((0 . "Line"))))
(if ss (progn
(setq i 0)
(repeat (sslength ss)
(setq tt (ssname ss i))
(setq data (entget tt))
(setq t1 (cdr (assoc 10 data)))
(setq t2 (cdr (assoc 11 data)))
(if (<= (sqrt (+ (expt (- (car t1) (car t2)) 2.0) (expt (- (cadr t1) (cadr t2)) 2.0))) m) (entdel tt))
(setq i (1+ i))
)
))
)
;;;(sc 2)
;;;(setq ss (ssget '((0 . "Line"))))
(defun sp(m /)
(setq ss (ssget '((0 . "Point"))))
(vl-cmdf "_ERSE" ss "")
)

这个用来删除指定长度的线条

Free-Lancer · 发表于 2013-6-1 16:35:04

hai20130408 发表于 2013-6-1 16:24
这个用来删除指定长度的线条

Line 的长度可以用 (distance p10 p11) 的，不用那么复杂的计算

非ing · 发表于 2013-6-1 16:36:59

本帖最后由 hai20130408 于 2013-6-1 16:41 编辑

Free-Lancer 发表于 2013-6-1 16:35
Line 的长度可以用 (distance p10 p11) 的，不用那么复杂的计算

是的，用distance好些。不过三维的点就不太适用了，因为一条线在平面视图状态下可能就只是一个点

非ing · 发表于 2013-6-1 16:42:07

hai20130408 发表于 2013-6-1 16:36
是的，用distance好些。不过三维的点就不太适用了，因为一条线在平面视图状态下可能就只是一个点

是的，用distance好些。不过三维的点就不太适用了，因为一条线在平面视图状态下可能就只是一个点

Free-Lancer · 发表于 2013-6-1 16:47:07

hai20130408 发表于 2013-6-1 16:42
是的，用distance好些。不过三维的点就不太适用了，因为一条线在平面视图状态下可能就只是一个点

对 Distance ，给的是二维点就是二维距离，如果是三维点就是三维距离，看Help

非ing · 发表于 2013-6-1 16:52:45

Free-Lancer 发表于 2013-6-1 16:47
对 Distance ，给的是二维点就是二维距离，如果是三维点就是三维距离，看Help

前辈，你说的没错，我考虑到了三维的直线在二维平面图下显示点的效果，实际这个程序的应用背景是：当一个填充图形被炸开块以后出现的很多细点，如果手动删除不仅不干净，而且速度慢。当然这里一般炸开后只有平面线条。但是对于有些线段实际是一条线，但是在xoy平面下只有一个点，或者一条短线，当删除这样一条直线，改程序依然适用，但是对于distance做判断条件得到的结果却是另外一种情况。

Lispboy · 发表于 2013-6-1 17:36:43

hai20130408 发表于 2013-6-1 16:52
前辈，你说的没错，我考虑到了三维的直线在二维平面图下显示点的效果，实际这个程序的应用背景是：当一个 ...

填充是平面实体啊，你的填充不是在一个面上做的？

Lispboy · 发表于 2013-6-1 17:39:48

楼主，你可以用向量的长度算距离，更简洁

;;;-----------------------------------------------------------;;
;;; 向量的模(长度) ;;
;;; Vector Norm - Lee Mac ;;
;;; Args: v - vector in R^n ;;
;;;-----------------------------------------------------------;;
(defun MAT:norm ( v )
(sqrt (apply '+ (mapcar '* v v)))
)

算两点距离的时候：

(setq dis (Mat:Norm (mapcar '- p2 p1)))

XDSoft · 发表于 2013-6-1 17:50:17

楼主，你的程序在你都正确交互的情况可能得到结果，但是中间如果有任何交互错误，比如没点到实体等，都会出错，程序应该加上必要的选择判断，我试着修改下你的程序，你看看。

(defun c:gj (/)
(if (and
(setq gj_ggname (entget (car (entsel "\n钢筋规格"))))
(cond
((setq kk (entsel "\n拾取实体确定钢筋长度<输入>:"))
(setq gj_cdname (entget (car kk))
gj_cd (atof (cdr (assoc 1 gj_cdname)))
)
)
(t
(setq gj_cd (getreal "\n输入钢筋长度<退出>："))
)
)
(setq gj_gs (getreal "\n钢筋根数<退出>：")) ; _钢筋根数
(setq gj_zcname (entget (car (entsel "\n什么提示，你自己输入<退出>:"))))
(setq gj_zlname (entget (car (entsel "\n什么提示，你自己输入<退出>:"))))
)
(progn
(setq gj_gg (atof (cdr (assoc 1 gj_ggname)))) ; _规格
(setq gj_zc (atof (cdr (assoc 1 gj_zcname)))) ; _求钢筋总长
(setq gj_zl (atof (cdr (assoc 1 gj_zlname)))) ; _求钢筋重量
(setq gj_zcnr (* gj_cd gj_gs))
(setq gj_zcnrf (rtos (/ (* gj_cd gj_gs) 1000.0) 2 1))
(setq gj_zlnr (rtos (/ (* (* 0.00617 (expt gj_gg 2.0)) gj_zcnr) 1000.0) 2 1))
(setq gj_zcnrf (cons 1 gj_zcnrf))
(setq gj_zlnr (cons 1 gj_zlnr))
(setq gj_zc (subst
gj_zcnrf
(assoc 1 gj_zcname)
gj_zcname
)
)
(setq gj_zl (subst
gj_zlnr
(assoc 1 gj_zlname)
gj_zlname
)
)
(entmod gj_zc)
(entmod gj_zl)
)
)
(prin1)
)

(defun c:gj (/) 
  (if (and 
        (setq gj_ggname (entget (car (entsel "\n钢筋规格")))) 
        (cond 
          ((setq kk (entsel "\n拾取实体确定钢筋长度<输入>:")) 
            (setq gj_cdname (entget (car kk)) 
                  gj_cd (atof (cdr (assoc 1 gj_cdname))) 
            ) 
          ) 
          (t 
            (setq gj_cd (getreal "\n输入钢筋长度<退出>：")) 
          ) 
        ) 
        (setq gj_gs (getreal "\n钢筋根数<退出>：")) ; _钢筋根数 
        (setq gj_zcname (entget (car (entsel "\n什么提示，你自己输入<退出>:")))) 
        (setq gj_zlname (entget (car (entsel "\n什么提示，你自己输入<退出>:")))) 
      ) 
    (progn 
      (setq gj_gg (atof (cdr (assoc 1 gj_ggname)))) ; _规格 
      (setq gj_zc (atof (cdr (assoc 1 gj_zcname)))) ; _求钢筋总长 
      (setq gj_zl (atof (cdr (assoc 1 gj_zlname)))) ; _求钢筋重量 
      (setq gj_zcnr (* gj_cd gj_gs)) 
      (setq gj_zcnrf (rtos (/ (* gj_cd gj_gs) 1000.0) 2 1)) 
      (setq gj_zlnr (rtos (/ (* (* 0.00617 (expt gj_gg 2.0)) gj_zcnr) 1000.0) 2 1)) 
      (setq gj_zcnrf (cons 1 gj_zcnrf)) 
      (setq gj_zlnr (cons 1 gj_zlnr)) 
      (setq gj_zc (subst 
                    gj_zcnrf 
                    (assoc 1 gj_zcname) 
                    gj_zcname 
                  ) 
      ) 
      (setq gj_zl (subst 
                    gj_zlnr 
                    (assoc 1 gj_zlname) 
                    gj_zlname 
                  ) 
      ) 
      (entmod gj_zc) 
      (entmod gj_zl) 
    ) 
  ) 
  (prin1) 
)

Free-Lancer · 发表于 2013-6-1 19:14:17

用distance计算一个2d距离和3d距离判断来自: Android客户端

GTJ116600 · 发表于 2013-6-1 20:11:45

呵呵，“授人以鱼不如授人以渔”，XDCAD真温暖

fkyourmather · 发表于 2013-6-2 18:50:25

这句话解释下～ (if (<= (sqrt (+ (expt (- (car t1) (car t2)) 2.0) (expt (- (cadr t1) (cadr t2)) 2.0))) m) (entdel tt))

非ing · 发表于 2013-6-3 12:35:28

Free-Lancer 发表于 2013-6-1 19:14
用distance计算一个2d距离和3d距离判断

呵呵，谢谢各位前辈高手对我的程序的点评，这些程序实际是在工作中随用随编的一些小工具，一些代码编写的也是没有考虑的十分周全。实际上正如我前面的帖子说我的动机确实不够纯正的，主要是为了看看有权限设置的精华帖，当然我这抛出来的臭泥砖，引来各位高手的金玉良言，也是意料之外。再次说声谢谢。

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

[每日一码] 再贴个算钢筋的小程序

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

评分

点评

点评

点评

点评

点评

点评

点评

点评

点评