平表法画吊筋
分享一个结构施工图画平表法吊筋的LISP，很久以前写的。选择边界的时候用的是ssget选取直线。问题是这些图素如果是在块里面就没办法了。我想改写一下：我的平面图整个是一个块，也能用多选的办法选取边界，不知道怎么办。有没有谁给指点指点？(defun c:dj(/ lines oos cla roo tbl p_st p_end paishu y_dn y_up x_lt x_rt
pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 d dd l ll alfa x y od_err num
dsym)
(defun dj_err(s)
(command "undo" "e")
(command "u")
(setq lines nil oos nil cla nil roo nil
tbl nil p_st nil p_end nil x_lt nil
x_rt nil y_up nil y_dn nil paishunil
d nil dd nil l nil ll nil
alfa nil x nil y nil pt1 nil
pt2 nil pt3 nil pt4 nil pt5 nil
pt6 nil pt7 nil pt8 nil od_errnil
num nil dsym nil pt1s nil pt2s nil
pt3s nil pt4s nil pt5s nil pt6s nil
pt7s nil pt8s nil
)
(setq *error* od_err)
(princ)
)
(command "undo" "g")
(setq od_err *error*)
(setq *error* dj_err)
(princ "\nselect lines.")
(setq lines (ssget '((0 . "LINE"))))
(initget "Horizntl Vertical")
(setq dsym (getkword "Vertical/<Horizntl>:"))
(if (null dsym) (setq dsym "Horizntl"))
(setq oos (getvar "OSMODE"))
(setq cla (getvar "CLAYER"))
(setvar "OSMODE" 0)
(command "ucs" "")
(setq roo (sslength lines))
(setq num 0)
(repeat roo
(setq tbl (entget (ssname lines num)))
(setq p_st (cdr (assoc 10 tbl)))
(setq p_end (cdr (assoc 11 tbl)))
(if (< (abs (- (car p_st) (car p_end))) 1e-6)
(progn
(if (or (null x_lt) (< (car p_st) x_lt))
(setq x_lt (car p_st))
)
(if (or (null x_rt) (> (car p_st) x_rt))
(setq x_rt (car p_st))
)
)
(if (< (abs (- (cadr p_st) (cadr p_end))) 1e-6)
(progn
(if (or (null y_dn) (< (cadr p_st) y_dn))
(setq y_dn (cadr p_st))
)
(if (or (null y_up) (> (cadr p_st) y_up))
(setq y_up (cadr p_st))
)
)
)
)
(setq num (1+ num))
)
(initget 6)
(setq paishu (getint "\nput in steel num <1>:"))
(if (null paishu) (setq paishu 1))
(setq d 50 ;多义线宽度
dd (* d paishu) ;钢筋排数
ll 200 ;水平段长度
l 100 ;每排间距
)
(setq alfa (/ pi 4))
(if (>= (- y_up y_dn) 800) (setq alfa (/ pi 3)))
(if (= "Horizntl" dsym)
(progn
(setq x (- x_lt d (/ (- y_up y_dn d dd) (/ (sin alfa) (cos alfa))) ll))
(setq y (- y_up d))
(setq pt1 (polar (list x y) (* -1 (/ pi 4)) l))
(setq pt2 (list x y))
(setq pt3 (polar pt2 0 ll))
(setq pt4 (polar pt3 (* -1 alfa) (/ (- y_up y_dn d dd) (sin alfa))))
(setq pt5 (polar pt4 0 (+ (* 2 d) (- x_rt x_lt))))
(setq pt6 (polar pt5 alfa (/ (- y_up y_dn d dd) (sin alfa))))
(setq pt7 (polar pt6 0 ll))
(setq pt8 (polar pt7 (* -1 (* pi 0.75)) l))
(command "layer" "m" "steel" "")
(command "pline" pt2 "w" d "" pt3 pt4 pt5 pt6 pt7 "")
(setq num 1)
(repeat 3
(setq pt5s (list (- x_lt (* num l)) y_up))
(setq pt6s (list (- x_lt (* num l)) y_dn))
(setq pt7s (list (+ x_rt (* num l)) y_up))
(setq pt8s (list (+ x_rt (* num l)) y_dn))
(setq num (1+ num))
(setq pt5 (trans pt5s 1 0))
(setq pt6 (trans pt6s 1 0))
(setq pt7 (trans pt7s 1 0))
(setq pt8 (trans pt8s 1 0))
(command "layer" "m" "hoop" "")
(command "ucs" "")
(command "pline" pt5 "w" d "" pt6 "")
(command "pline" pt7 "w" d "" pt8 "")
(command "ucs" "p")
)
)
(progn
(setq y (- y_dn d (/ (- x_rt x_lt d dd) (/ (cos alfa) (sin alfa))) ll))
(setq x (+ x_lt d))
(setq pt1 (polar (list x y) (/ pi 4) l))
(setq pt2 (list x y))
(setq pt3 (polar pt2 (/ pi 2) ll))
(setq pt4 (polar pt3 (- (/ pi 2) alfa) (/ (- x_rt x_lt d dd) (sin alfa))))
(setq pt5 (polar pt4 (/ pi 2) (+ (* 2 d) (- y_up y_dn))))
(setq pt6 (polar pt5 (+ (/ pi 2) alfa) (/ (- x_rt x_lt d dd) (sin alfa))))
(setq pt7 (polar pt6 (/ pi 2) ll))
(setq pt8 (polar pt7 (* -1 (* pi 0.25)) l))
(command "layer" "m" "steel" "")
(command "pline" pt2 "w" d "" pt3 pt4 pt5 pt6 pt7 "")
(setq num 1)
(repeat 3
(setq pt1s (list x_lt (+ y_up (* num l))))
(setq pt2s (list x_rt (+ y_up (* num l))))
(setq pt3s (list x_lt (- y_dn (* num l))))
(setq pt4s (list x_rt (- y_dn (* num l))))
(setq num (1+ num))
(setq pt1 (trans pt1s 1 0))
(setq pt2 (trans pt2s 1 0))
(setq pt3 (trans pt3s 1 0))
(setq pt4 (trans pt4s 1 0))
(command "layer" "m" "hoop" "")
(command "ucs" "")
(command "pline" pt1 "w" d "" pt2 "")
(command "pline" pt3 "w" d "" pt4 "")
(command "ucs" "p")
)
)
)
(setvar "OSMODE" oos)
(setvar "CLAYER" cla)
(setq *error* od_err)
(command "ucs" "p")
(command "undo" "e")
(princ)
)
页:
[1]