[Lisp] 치수 테두리에 슬롯 그리기 리습입니다. 살짝만 업그레이드 요청드립니다.

[이상훈]

※ 말머리 필수 (말머리 누락시 통보없이 게시 글이 삭제될 수 있습니다.)

※ 회원정보는 최소한 '운영진 공개'로 지정

※ 캐드나 리습 관련 질문일 경우 반드시 캐드 종류와 버전 명기 (ex> 오토캐드2022 / 윈10 64비트)

   <캐드 / 윈도우 종류 및 버전 :    오토캐드2023                        /    윈10 64비트                           >

※ 질문은 최대한 성의있고 자세하게 (답변자가 되묻게 질문하지 말아주세요.)

※ 이외는 자유롭게 글 남겨 주시면 됩니다.

안녕하세요!

지난 번, 일도님과 자유천지님께서 도움주셨던 치수 테두리에 슬롯 그리기 리습입니다.

최초 리습에서, 레이어 지정 등의 기능을 추가하여 사용 정말 잘 하고 있습니다.

사용하다보니 텍스트 색도 변경되면 좋을 것 같아서,

혼자 이리저리 시도해보는데 쉽지 않아 도움을 청해봅니다.

리습 코드에서 색상코드를 지정하여,

슬롯 생성과 함께 텍스트 색까지 변경되었으면 합니다.

매번 주시는 도움에 감사드립니다.

< 현재 리습 코드 > 

(defun c:E1 ( ) (draw-rectangle-around-dimension-text)) ; 명령어 여기에서 변경하면됨
(defun draw-rectangle-around-dimension-text ( / ss1 en1 ent1 type1 text1 style1 height1 i
           offset_factor rect_color rect_width offset_dist ang90 ang1 ang1a
           p_mid p1 p2 p3 p4 box1 dx dy dx5 dy5 dim_block_name ent_pline )
;
;--------------------------------------------------------
; 초기값
;--------------------------------------------------------
  (setq oldlayer (getvar "clayer"))
  (setq offset_factor 0.3) ; 거리 간격띄우기 비율 (치수문자크기 * 0.35) , 여기에서 변경하면됨
  (setq rect_color 3) ; 테두리 색상(3=초록색, 256=bylayer), 여기에서 변경하면 됨
  (setq rect_width 4.0) ; 테두리 두께. 여기에서 변경하면 됨
;--------------------------------------------------------
  (setq ang90 (* 0.5 pi))
  (setvar "cmdecho" 0)
;
  (princ "\n네모 테두리를 그릴 치수 선택: ")
  (if (setq ss1 (ssget '((0 . "dimension")))) (progn
      (vl-cmdf "undo" "be")
      (foreach en1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1)))
          (setq ent1 (entget en1))
;
;         치수문자의 위치
          (setq p_mid (cdr (assoc 11 ent1))) ; 치수문자의 중간점
;
;         치수문자 entity 찾기
          (setq dim_block_name (cdr (assoc 2 ent1))) ; 치수에 대한 블록이름
          (setq en1 (entnext (tblobjname "block" dim_block_name)))
          (while en1 ; 치수블록안의 객체 하나씩 뒤지기
              (setq ent1 (entget en1)) ; ent1=치수문자의 elist 찾기
              (setq type1 (cdr (assoc 0 ent1)))
              (if (= "MTEXT" type1) ; 치수블록안의 객체 타입이 mtext 이면 이게 치수문자임
                  (setq en1 nil) ; 치수문자를 찾았으면 while 을 빠져나감
                  (setq en1 (entnext en1)) ; 치수문자가 아니면 다음 거 뒤지기 계속
              ) ; if
          ) ; while
;
;         치수문자 값, 각도, 스타일, 크기 찾기
          (setq text1 (cdr (assoc 1 ent1)))
          (if (setq i (vl-string-search ";" text1)) (setq text1 (substr text1 (+ 2 i)))) ; 치수문자(mtext)의 format code "\A1;" 제거하고 눈에 보이는 문자만 남기기
          (setq ang1 (cdr (assoc 50 ent1))) ; 치수문자의 각도
          (setq ang1a (+ ang1 ang90))
          (setq style1 (cdr (assoc 7 ent1)))
          (setq height1 (cdr (assoc 40 ent1)))
;
;         치수문자 둘레 계산하기
          (setq box1 (textbox (list '(0 . "text") (cons 1 text1) (cons 7 style1) (cons 40 height1))))
          (setq p1 (car box1))
          (setq p3 (cadr box1))
          (setq dx (- (car p3) (car p1)))
          (setq dy (- (cadr p3) (cadr p1)))
          (setq offset_dist (* offset_factor height1))
          (setq dx (+ dx offset_dist offset_dist))
          (setq dy (+ dy offset_dist offset_dist))
          (setq dx5 (* 0.5 dx))
          (setq dy5 (* 0.5 dy))
;
;         치수문자 네모 테두리 점 구하기
          (setq p1 (polar (polar p_mid ang1 (- dx5)) ang1a (- dy5))) ; 좌하점
          (setq p2 (polar p1 ang1 dx)) ; 우하점
          (setq p3 (polar p2 ang1a dy)) ; 우상점
          (setq p4 (polar p1 ang1a dy)) ; 좌상점
;
;         치수문자 슬롯 테두리 그리기
          (setvar "clayer" "dim")  ;; 현재 레이어를 dim로 변경
          (setq ent_pline (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) (cons 62 rect_color) (cons 43 rect_width)))
          (setq ent_pline (append ent_pline (list (cons 10 p1) (cons 10 p2) (cons 42 1.0) (cons 10 p3) (cons 10 p4) (cons 42 1.0))))
          (entmake ent_pline)
      ) ; foreach en1/en_list
      (vl-cmdf "undo" "e")
  )) ; if ss1 & progn
;
  (setvar "clayer" oldlayer) ;; 이전 레이어로 되돌아가기
  (princ)
) ; end of (draw-rectangle-around-dimension-text)
;
;========================================================
(princ)

makeslot.lsp

3.98KB

test.dwg

221.75KB