; 블록 되돌리기(2007.4 주말농부)
; ->미러/로테이트 된 블록을 되돌려주는 리습
; ->삽입점(dxf10)의 좌표도 되돌려줌
; ->제외블럭(fr1,fr2) 추가 (2007.8.17)
; ->속성블럭도 되돌림(2007.8.27)
(defun c:q(/ ss ssn cm k ed db10 db41 db43 db210 blist);q가 명령어,변경후 사용
(prompt " mirror & rotate된 블럭을 되돌림...")
(setq ss (ssget (list (cons 0 "insert"))))
(setq cm (getvar "cmdecho"))
(setq blist '())
(if ss (progn
(setvar "cmdecho" 0)
(setq k 0 ssn (sslength ss))
(repeat ssn
(setq ed (entget (ssname ss k)))
;-->
(setq bn (strcase (cdr (assoc 2 ed))))
(if (or (= bn "FR1")(= bn "FR2"))
(progn (prompt "\n제외블럭:")(prin1 bn))
(progn
(setq db41 (abs (cdr (assoc 41 ed)))
db43 (abs (cdr (assoc 43 ed)))
db210 (cdr (assoc 210 ed))
db10 (cdr (assoc 10 ed))
ed (subst (cons 41 db41) (assoc 41 ed) ed)
ed (subst (cons 43 db43) (assoc 43 ed) ed)
ed (subst (cons 50 0) (assoc 50 ed) ed))
(if (< (caddr db210) 0.0)(progn
(setq db210 (list (car db210) (cadr db210) (abs (caddr db210)))
ed (subst (cons 210 db210) (assoc 210 ed) ed)
db10 (list (* (car db10) -1.0) (cadr db10) (caddr db10))
ed (subst (cons 10 db10) (assoc 10 ed) ed))
) )
(entmod ed)
(if (assoc 66 ed) (setq blist (cons bn blist)) )
)
)
;--<
(setq k (+ k 1))
);repeat end
(if blist (@str_memb blist))
(setvar "cmdecho" cm)
))
(prin1))
;중복된 블럭명을 제거하고 속성블럭 되돌리기
(defun @str_memb (str_lst / a b)
(setq k 0)
(setq b (reverse str_lst))
(mapcar '(lambda (x) (if (= (member x a) nil) (setq a (cons x a)))) b)
(setq ssn (length a))
(repeat ssn
(command "ATTSYNC" "n" (nth k a))
(setq k (+ k 1))
)
)
'■ 유용한 캐드&리습 > ▫ AutoLISP' 카테고리의 다른 글
텍스트로 된 X,Y 좌표을 찍어 위치표현하기 (1) | 2024.12.31 |
---|---|
좌표표기하기 (0) | 2024.12.31 |
리습 - 선택한 블럭의 좌표 뽑기-2 (7-0815) (0) | 2024.12.31 |
선택한 블럭의 좌표 뽑기-1 (7-0814) (0) | 2024.12.31 |
선택한 블럭의 좌표 뽑기(7-0812) (0) | 2024.12.31 |