grread lisp 橡皮筋_晓东CAD家园-论坛-A/VLISP-[LISP程序]：grread模拟橡皮筋-这个程序是自己写的grread模拟橡皮筋，但没能达到预想效果，请高手改错，谢谢,测试请用...

最初由 gysjy 发布

[B]可以。拉伸钢筋的程序曾经在该网站上发过，后来由于网站的原因，地址失效了。 [/B]

是这个吗？以前在网上下的

(defun c:bj(/ p pt dis p1 p2 s1 s2 )

;;拉伸钢筋程序, 用于探索者或PKPM的板钢筋编辑;;

(setq oer *error* *error* myerr)

(setvar "cmdecho" 0)

(setq box (getvar "pickbox"))

(setvar "osmode" 0)

(setvar "orthomode" 1)

(command "undo" "g")

(setvar "pickbox" 20)

(setq p (entsel "\n指定要拉伸的范围:"))

(setvar "pickbox" box)

(while p

(setq pt (cadr p) dis (* 0.034 (getvar "viewsize"))

p1 (polar pt 0.79 dis) p2 (polar pt 3.93 dis)

s1 (ssget "c" p1 p2)

s2 (ssget "p" '((-4 . "")))

)

(if s2 (command "stretch" "c" p1 p2 "r" s1 "a" s2 "" pt pause)

(princ "\n复选框中没有选中钢筋。")

)

(command "undo" "end")

(setvar "pickbox" 20)

(setq p (entsel "\n指定要拉伸的范围:"))

(setvar "pickbox" box)

);while

(setq *error* oer)

(princ)

)

(defun c:hf() (setvar "pickbox" (if box box 5))(princ))

(defun c:gj(/ p1 p2 p3 p4 p5 s1 s2 sn pt1 pt2 os)

;;延伸钢筋程序, 用于探索者或PKPM的板钢筋编辑;;

(setq oer *error* *error* myerr os (getvar "osmode"))

(command "undo" "g")

(setvar "cmdecho" 0)

(setvar "osmode" 0)

(setq p1 (cadr (entsel "\n点取界线:"))

p1 (osnap p1 "nea") p2 (osnap p1 "end")

)

(while (setq s1 (entsel "\n点取要延伸的钢筋:"))

(setq

sn (car s1)

s2 (ssget "p" '((-4 . "

(8 . "REIN")(8 . "支座钢筋")

(8 . "板底钢筋")(-4 . "OR>"))

)

p3 (cadr s1) p3 (osnap p3 "nea") p4 (osnap p3 "end")

pt1 (polar p4 0.79 500) pt2 (polar p4 3.93 500)

p5 (inters p1 p2 p3 p4 nil)

)

(if p5

(if (or (eq (to 8) "REIN")

(eq (to 8) "支座钢筋")

(eq (to 8) "板底钢筋")

(eq (to 8) "GANGJ")

)

(if (< (distance p4 p5) 80000)

(command "stretch" "c" pt1 pt2 "r" "all" "a" sn "" p4 p5)

(princ "\n\t ***  与界线平行不能延伸。 ***")

)

(princ "\n\t ***  您没有选中钢筋。  ***")

)

(princ "\n\t ***  与界线平行不能延伸。 ***")

)

);while

(setvar "osmode" os)

(command "undo" "end")

(setq *error* oer)

(princ)

)

(defun c:mgj(/ p pt dis p1 p2 p3 s1 s2 )

;;钢筋镜像程序, 用于探索者或PKPM的板钢筋编辑;;

;(setq oer *error* *error* myerr)

(setvar "cmdecho" 0)

(setq box (getvar "pickbox") ap (getvar "APERTURE"))

(setvar "osmode" 0)

(setvar "orthomode" 1)

(command "undo" "g")

(setvar "pickbox" 10)

(setvar "APERTURE" 10)

(setq p (entsel "\n指定要镜像的钢筋:"))

(setvar "pickbox" box)

(while p

(setq pt (cadr p) dis (* 0.017 (getvar "viewsize"))

p1 (polar pt 0.79 dis) p2 (polar pt 3.93 dis)

p3 (osnap pt "nea")

s1 (ssget "c" p1 p2)

s2 (ssget "p" '((-4 . "")))

)

(if (and p3 s2) (command "mirror" s2 "" p3 (osnap p3 "end") "y")

(princ "\n\t ** 复选框中没有选中钢筋。**")

)

(command "undo" "end")

(setvar "pickbox" 10)

(setq p (entsel "\n指定要拉伸的范围:"))

(setvar "pickbox" box)

);while

(setvar "APERTURE" ap)

(setq *error* oer)

(princ)

)

(defun to(n)

(cdr (assoc n (entget sn)))

)

(defun myerr (s)

(if (/= s "Function canccelled")

(if (= (substr s 1 13) "null function")

(princ "\n该程序不能运行.") (princ "\n程序中止")

)

)

(setq *error* oer)

(princ)

)