CAFE

★ CAD/LISP/분과 Q&A

블럭 레이어 및 색상 변경 리습 수정 요청 드립니다~

작성자그날을향해|작성시간25.03.11|조회수278 목록 댓글 0

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

 

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

 

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

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

 

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

 

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

 

안녕하세요. 아키모아에서 다운 받아 사용중인 리습입니다.

오토캐드를 사용할때 유용하게 사용하던 리습인데, 회사 사정상 zwcad로 변경하다보니 

리습이 작동 되지 않아 요청드립니다. 수정 가능 하시면 부탁드립니다. 감사합니다.

네트워크 보안상 파일이 업로드 되지 이렇게 남깁니다.

 

(defun c:11 (/ ss l :Adoc :Blocks :Layers)
      (vl-load-com)
      (and
        (progn
          (princ "\n레이어를 바꿀 블럭들을 선택: ")
          (or
            (setq ss (ssget '((0 . "insert"))))
            (alert "선택한 블럭이 없습니다!   ")
          )
        )
        (progn
          (setq    l
                (mapcar
                      '(lambda (e) (cdr (assoc 2 (entget e))))
                      (vl-remove-if
                        'listp
                        (mapcar 'cadr (ssnamex ss))
                      )
                )
            :Adoc    (vla-get-activedocument
                      (vlax-get-acad-object)
                )
            :Blocks    (vlax-get :Adoc 'Blocks)
            :Layers    (vlax-get :Adoc 'Layers)
          )
          (and (eq 8 (logand 8 (getvar 'undoctl)))
               (vla-endundomark :Adoc)
          )
          (vla-startundomark :Adoc)
          (vlax-for block :Blocks
            (if (vl-position (vla-get-name block) l)
                  (vlax-for    o block
                    (if    (= (vlax-get o 'color) 256)
                      (vlax-put
                        o
                        'Color
                        (vlax-get
                              (vla-item
                                :Layers
                                (vlax-get
                                  o
                                  'Layer
                                )
                              )
                              'Color
                        )
                      )
                    )
                    (vlax-put o 'Layer 0)
                  )
            )
          )
          (and (eq 8 (logand 8 (getvar 'undoctl)))
               (vla-endundomark :Adoc)
          )
          (vla-regen :Adoc 1)
          (mapcar 'vlax-release-object
              (list :Adoc :Blocks :Layers)
          )
        )
      )
      (princ)
)

다음검색
현재 게시글 추가 기능 열기

댓글

댓글 리스트
맨위로

카페 검색

카페 검색어 입력폼