本帖最后由 vitalgg 于 2023-5-26 09:22 编辑
- (defun c:at-rc ()
- ;; 选择矩形
- (setq recs
- (vl-remove-if-not 'curve:rectanglep
- (pickset:to-list(ssget '((0 . "lwpolyline"))))))
- (foreach rec recs
- (setq box (entity:getbox rec 0))
- (setq h (- (cadadr box) (cadar box)))
- (setq w (- (caadr box) (caar box)))
- (if (> w h)
- ;; 水平矩形为红色
- (entity:putdxf rec 62 1)
- ;; 竖向矩形为绿色
- (entity:putdxf rec 62 3)
- )
- )
- )
|