求按标准线拉伸或缩短线的lsp程序0003

品茗新秀 · 发表于 2012-9-9 12:06:34

本帖最后由品茗新秀于 2012-9-9 15:03 编辑

做一个过程演示双击下图可更加清楚

其实就是把柱梁向右移动100mmm

品茗新秀 · 发表于 2012-9-9 15:01:09

品茗新秀发表于 2012-9-9 12:06
做一个过程演示

双击上图可更加清楚

【KAIXIN】 · 发表于 2012-9-18 08:09:48

LISP不是万能的，有些东西不能一个程序解决，得分开来

crazylsp · 发表于 2012-9-24 10:07:53

选一个标准长度再选其它，都变成标准长度并写出字"d8@200"，是这个意思吗? 有弯钩否?

品茗新秀 · 发表于 2012-9-24 18:25:17

crazylsp 发表于 2012-9-24 10:07
选一个标准长度再选其它，都变成标准长度并写出字"d8@200"，是这个意思吗? 有弯钩否?

不问有无弯钩，对没有标注的钢筋补上标注d8@200

sscylh · 发表于 2012-9-24 18:32:19

楼主,不知道有vba您同意吗?我自己对lisp几乎一窍不通,就会些基础很常用,像vl函数都不会.............
vba还可以,应该用lisp能做的,vba应该也都能做吧

品茗新秀 · 发表于 2012-9-24 18:40:04

sscylh 发表于 2012-9-24 18:32
楼主,不知道有vba您同意吗?我自己对lisp几乎一窍不通,就会些基础很常用,像vl函数都不会.............
vb ...

行，同意，只好从vba中找感觉，

yjr111 · 发表于 2012-9-25 22:58:34

图层就是钢筋标注图层，只不过我把文字颜色改为红色显眼一点罢了，，，

yjr111 · 发表于 2013-5-25 23:05:09

附上源码：

(defun getmp(e / midp)
(setq midp(vlax-curve-getPointAtParam e(/(-(vlax-curve-getEndParam e)
(vlax-curve-getStartParam e)) 2))
)
)
(defun maketxt(e / sp ep mp pam1 newe newmp txtp)
(if (= 3.0 (vlax-curve-getEndParam e))
(progn
(setq sp(vlax-curve-getPointAtParam e 0)
ep(vlax-curve-getPointAtParam e 3)
mp(getmp e)
pam1(vlax-curve-getPointAtParam e 1)
pam2(vlax-curve-getPointAtParam e 2)
ang(angle sp ep)
)
(entmake (list '(0 . "LINE") (cons 10 sp) (cons 11 ep)))
(setq newe(entlast)
newmp(getmp newe)
DIS (DISTANCE sp pam1)
)
(entdel newe)
(setq ep1(polar ep (angle ep pam2)(+ DIS 100)))
(setq areadss(ssget "c" sp ep1 '((0 . "TEXT")(1 . "*[@]*"))))
(if areadss (setq ang1(cdr(assoc 50 (entget(ssname areadss 0))))))
(if (or (not areadss)(/= ang ang1))
(PROGN
(setq txtp(polar newmp (angle sp pam1)(+ DIS 50)))
(entmake (list '(0 . "TEXT") (cons 1 "%%1328@200")(cons 8 "板底钢筋标注")
(cons 10 '(0 0 0)) (cons 11 txtp)(cons 40 160)
(cons 50 ang)(cons 62 1)(cons 72 1)(cons 73 1)
)
)
)
)
)
)
)
(defun c:xgj(/ ss n)
(command "undo" "be")
(setq ss(ssget '((0 . "LWPOLYLINE")(8 . "*钢筋"))))
(if ss
(repeat (setq n(sslength ss))
(maketxt (ssname ss (setq n(1- n))))
)
)
(command "undo" "e")
(princ)
)

(defun getmp(e / midp) 
  (setq midp(vlax-curve-getPointAtParam e(/(-(vlax-curve-getEndParam e) 
                 (vlax-curve-getStartParam e)) 2)) 
        ) 
) 
(defun maketxt(e / sp ep mp pam1 newe newmp txtp) 
  (if (= 3.0 (vlax-curve-getEndParam e)) 
    (progn 
      (setq sp(vlax-curve-getPointAtParam e 0) 
            ep(vlax-curve-getPointAtParam e 3) 
            mp(getmp e) 
            pam1(vlax-curve-getPointAtParam e 1) 
            pam2(vlax-curve-getPointAtParam e 2) 
            ang(angle sp ep) 
            ) 
      (entmake (list '(0 . "LINE") (cons 10 sp) (cons 11 ep))) 
      (setq newe(entlast) 
            newmp(getmp newe) 
            DIS (DISTANCE sp pam1) 
            )       
      (entdel newe) 
      (setq ep1(polar ep (angle ep pam2)(+ DIS 100))) 
      (setq areadss(ssget "c" sp ep1 '((0 . "TEXT")(1 . "*[@]*")))) 
      (if  areadss (setq ang1(cdr(assoc 50 (entget(ssname areadss 0)))))) 
      (if (or (not areadss)(/= ang ang1))                                        
        (PROGN 
          (setq txtp(polar newmp (angle sp pam1)(+ DIS 50)))       
          (entmake (list '(0 . "TEXT") (cons 1 "%%1328@200")(cons 8 "板底钢筋标注") 
                      (cons 10 '(0 0 0)) (cons 11 txtp)(cons 40 160) 
                      (cons 50 ang)(cons 62 1)(cons 72 1)(cons 73 1) 
                      ) 
          ) 
        ) 
      ) 
    ) 
  ) 
) 
(defun c:xgj(/ ss n) 
  (command "undo" "be") 
  (setq ss(ssget '((0 . "LWPOLYLINE")(8 . "*钢筋")))) 
  (if ss 
  (repeat (setq n(sslength ss)) 
    (maketxt (ssname ss (setq n(1- n)))) 
    ) 
  ) 
  (command "undo" "e") 
  (princ) 
  )

goldwheat · 发表于 2013-6-6 13:51:16

这个很实用的，下载了，多谢分享源码。

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

求按标准线拉伸或缩短线的lsp程序0003

本帖子中包含更多资源

点评

点评

点评