平表法画吊筋

caoyalu

分享一个结构施工图画平表法吊筋的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     paishu  nil
                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_err  nil
                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)
)