[리습풀이]Re:(예제 46) 파트리스트 만들기-별지기님요청

[행복한하루]

우선 동영상에서 순서를 잘보세염.^^

그럼 리습이해하기가 더 쉬우실겁니다.^^

(defun c:qwe(/ os ent en minpt maxpt bn scal baseang p1 p2 dis1 dis2 ap1 ss k en1 $p1 $p2 ss1 ak atxt-list aed atxt avar ap2 ass)

;; defun 정의와 지역변수입니다.
;->*error* start  
 (defun *error* (msg)(princ "error: ")(princ msg)
 (setvar "osmode" os) (if ent (redraw ent 4))
 (princ))
;-<*error* end

;; 에러문구 처리져...esc 키등으로 종료가 되면... 오스냅을 다시 돌려주고.. 선택객체가

;; 하이라이트가 되어있다면.. 해제를 시켜라 입니다... 다 필요없구염..파란색부분만 보시면되염.^^
 (vl-load-com)

;; 이건 비주얼리습을 사용할때 써줘야합니다.^^ 아래..vlax 함수를 써서염..^^
 (setq os (getvar "osmode"))

;; 현재오스냅을 가져옵니다..
 (setq ent nil)

;; 초기값설정이져... ent가 잇을지도 모르니..^^ 미리..nil로 만들어 버립니다.
 (while (= ent nil) (setq ent (car (entsel "\n블럭을 선택하세요. 한개만."))))

;; entsel 로 받을때..잘못선택하는 경우가 많습니다..한객체만 선택이라서..그래서...

;; 선택이 될때까지.. 계속 찍을수 있게 while로 돌려줍니다..
 (setq en (cdr (assoc 0 (entget ent))))

;; 찍은거의..엔티티네임을 가져옵니다..블럭을 선택했는지 않했는지 판단하기 위해...

;; 블럭을 선택했으면...en 는 insert 가 되서..아래 루틴이 실행이 되져..아니면 종료가 되구염.

;;--------------------------------------------여기까지는 별생각할게 없져..^^

 (if (= en "INSERT")

;; 만약 블럭이 선택이 되었다면...실행해라..져..
  (progn
   (redraw ent 3)

;; 선택한 블럭을 하이라이드 시켜줍니다..
   (setvar "osmode" 0)

;; 오스냅을 꺼주고염..
   (vla-GetBoundingBox (vlax-ename->vla-object ent) 'MinPt 'MaxPt)
   (setq MinPt (vlax-safearray->list MinPt))
   (setq MaxPt (vlax-safearray->list MaxPt))

;; 요기까지는...비주얼리습입니다...minpt 는 해당 블럭의 왼쪽하단.. maxpt 는 오른쪽 상단..

;; 도곽을 선택하니... 도곽의 왼쪽 아래점... 오른쪽 위쪼포인트가 되겠져..
   (command "zoom" minpt maxpt)

;; zoom 으로.. 해당 도곽을 땡기게 되져..
   (setq bn (cdr (assoc 2 (entget ent))))

;; 해당 도곽의 블럭이름을 가져옵니다... 요건.. 같은 블럭을 나중에 선택하기 위해...
   (setq scal (abs (cdr (assoc 41 (entget ent)))))

;; 블럭의 x스케일값을 가져오게 됩니다.. 이유는... 도곽이 일정축척이면 상관없지만..

;;  1/100 ... 1/200 등등.. 틀릴경우.. 도곽의 비율에 따라..해당 텍스트위치를 정해주기 위해서..
   (setq baseang (cdr (assoc 50 (entget ent))))

;; 블럭의 회전값을 가져옵니다...

;; 이유는... 처음선택한..블럭이름과.. 회전갑이 같은 것만 선택해주기 위해서 입니다..

;; 회전이 된거 신경쓰기 귄찬아서..^^:;;;;;;;

;;--------------------------------요기까지는..기본적인 dxf코드로 값을 가저오는과정

   (setq p1 (getpoint "\파트리스트에 쓰일 text 구역지정:")
         p2 (getcorner p1 " ->다음점:"))

;; 파트리스트에 쓰여질 텍스트의 영역을 정해줍니다.. 해당 영역안에 잇는 텍스트들이 선택이 되서

;; 파트리스트에 쓰여지는거져..
   (setq dis1 (/ (distance minpt p1) scal) ang1 (angle minpt p1))
   (setq dis2 (/ (distance minpt p2) scal) ang2 (angle minpt p2))

;; 요게 바로... 도곽의스케일별로 텍스트구역을 지정해주게 기본값..즉 비율을 정해주는부분이예염..

;; 즉..도곽의왼쪽하단포인트 부터... 해당포인트까지 거리를 구해서.. 해당 블럭스케일값으로 나누어

;; 줍니다..그럼...도곽이...1:1일때의 해당 거리값을 구할수가 있어염...각도도 구했으니..

;; 거리와 방향 을 알고 있으니...x 해당 스케일만 해주면... 동일비율블럭에서.. 위치를 알수가 있져..

   (command "zoom" "e")

;; 동영상에서 진행을 보시면.. 도곽선택후.. 도곽확대.. 텍스트구역지정..후..zoom>e가 되져..

;; 파트리스트표를 찾기편하기 위해서염..^^
   (setq ap1 (getpoint "\n파트리스트 텍스트포인트:"))

;; 파트리스트표에.. 텍스트를 써줄 위치를 지정해줍니다..
   (command "zoom" "e")

;; 다시 이젠 파트리스트표에 써줄 텍스트가 있는 도곽을 선택하기 위해서..
   (setq ap1 (polar ap1 0 9.89))
   (setq ap1 (polar ap1 (/ pi 2) 0.84))

;; 요건 그냥 무시하셔도 됩니다..찍은포인트로 부터..텍스트의 위치를 조정해기 위해서 포인트를

;; 점 움직이는 과정이예염..^^
   (prompt "\n>> 블럭 선택:")
   (setq ss (ssget (list (cons 0 "insert") (cons 2 bn) (cons 50 baseang))))

;; 처음선택한 도곽과 같은이름의 같은 방향의 블럭만 선택가능하게 해줍니다.
   (setq ss (@ss_new_lst_x ss))

;; 자 요건 서브루틴이 포함되어있네염.^^ @ss_new_lst_x  요게 바로 서브루틴입니다.

;; 저~ 아래 보시면... (defun @ss_new_lst_x () 요렇게 된거를 실행하라는겁니다.

;; 실행하고 빠져나오면...선택객체..즉 도곽이 왼쪽꺼부터 정렬이 되서..

;; 파트리스트에 써지는 순서가..젤 왼쪽 도곽부터 텍스트를 읽어와서 써지게 되염.

;; 요건 저~~아래 예제 보시면.. 선택객체정렬이라고 풀어논거 있습니다.^^
   (setq k 0)

;; repeat 돌리기 위한 초기값이져..

;;-------------위에서 기본적인건 선택이 다끝났져...그럼 이젠 적용만 남았습니다.
;;-------------아래 루틴들은..위에꺼 거의 반복입니다.. ^^ 

   (repeat (sslength ss) 

;;  ss 란.. 파트리스트가 들어있는 도곽들이져... 해당 도곽갯수만큼 돌립니다.
    (setq en1 (ssname ss k))

;; 엔티티이름을 가져오구염..
    (setq scal (abs (cdr (assoc 41 (entget en1)))))

;; 블럭의 스케일값을 가져옵니다...
    (vla-GetBoundingBox (vlax-ename->vla-object en1) 'MinPt 'MaxPt)
    (setq MinPt (vlax-safearray->list MinPt))
    (setq MaxPt (vlax-safearray->list MaxPt))

;; 해당 블럭의...좌하단점 우상단점을 가져옵니다...여기까진 거의 같져..^^
    (setq $p1 (polar minpt ang1 (* dis1 scal)))
    (setq $p2 (polar minpt ang2 (* dis2 scal)))

;; 두점을 구해줍니다...이게 도곽의 크기에 따른 텍스트구역의 포인트져...

;; 위에 이미지에도 보이듯이... 기준점과... 거리와 각도만 알면...구역을 알수 있져..

;; 도곽의 스케일에 따라 틀려져야되니...x scal 을 하게 되져..
    (setq ss1 (ssget "c" $p1 $p2 (list (cons 0 "text,mtext"))))

;; 해당 구역을 선택해줍니다...선택은...text만 선택이 되게...
    (setq ss1 (@ss_new_lst_11 ss1))

;; 텍스트가 왼쪽부터 선택객체에 정렬이 되게.. 서브루틴을 통과시키게됩니다..

;; 왼쪽부터...파트리스트에 순서대로 써져야되니까염...
    (setq ak 0 atxt-list'())

;; 초기값이져...

;;-------------요 아래 repeat는 텍스트 리스트를 만들어주기 위해서..

    (repeat (sslength ss1)

;; 자 위에 repeat는 도곽을돌리는 repeat 입니다...

;; 그럼 이 repeat는???? 텍스트가 여러개잔아염?? 그러니..해당 텍스트갯수만큼 써줘야되니...^^
     (setq aed (entget (ssname ss1 ak)))

;; 엔티티리스트를 가져오구염
     (setq atxt (cdr (assoc 1 aed)))

;; 해당 텍스트값을 가져옵니다..
     (setq atxt-list (append atxt-list (list atxt)))
     (setq ak (1+ ak))
    )

;; 자...요기까지... 하시면.. ("텍스트" "텍스트" "텍스트"...) 이렇게 되염...즉..list화를 시켜줘염..

;;---------------------------------------------------------------

    (setq avar 0)
    (setq ap2 ap1)

;; 초기값이구염..
    (setq ass (ssadd))

;; 이건..그다지 필요없습니다.. 파트리스트에..글씨를 써주는데...

;; 글씨가 길어서 안들어가서..글자폭 조절해줄려고.... 선택객체를 묶는과정입니다.

;; 저~ 아래..tw를 실행시킬려고...

;;-----------------------------------텍스트를 실제로 화면에 써주는부분

    (foreach x atxt-list

;; foreach는 repeat와 유사합니다.. 아까 만든...텍스트리스트를 요소별로 하나씩 실행해줘염..
     (progn (command "text" "j" "bc" ap2 2.97 0 x) (ssadd (entlast) ass)

;; 텍스트 처음꺼를 하나 써주게 되염..^^
      (cond ((= avar 0) (setq ap2 (polar ap2 0 25.80)))
            ((= avar 1) (setq ap2 (polar ap2 0 34.64)))
            ((= avar 2) (setq ap2 (polar ap2 0 12.26)))
            ((= avar 3) (setq ap2 (polar ap2 0 29.16)))
       )

;; 이거 모냐면여..^^;;;; 크게 신경쓰지 안아도 되염... 글씨의 위치를 그냥 지정해 논것입니다..

;; 처음에 글씨 써주고..그 다음에 글씨쯜때... avar 가 1씩 증가하니.... 글씨쓰는 포인트가..ap2

;; 즉...cond에서 ap2가 지정값으로 자꾸 변하게 되서..

;; 텍스트가 칸에 딱딱 맞게 들어가져...^^:;;;
       (setq avar (1+ avar))
      )
     )

;;---------------------------------------------------------------
    (tw ass)

;; 이건 서브루틴을 통해서... 텍스트의 폭을 조절하기 위해서 입니다.^^;; 없어도 그만...^^
    (setq ap1 (polar ap1 (+ (/ pi 2) pi) 6))

;; 자 여기까지 한줄을 쓴게 됩니다... 한줄쓰고...다시 다른도곽에서 해당 텍스트값을 가져올때..

;;  ap1 은 처음 파트리스트에 텍스트가 써지는 포인트입니다..

;; 그러니..다름 도곽넘어가기 전에... 한줄 아래로 내려야겠져...(+ (/ pi 2) pi) 가 270도 ㅖ염..^^

;; 즉..아래 쪽으로 포인트를....6만큼 이동한다는 거져..
    (setq k (1+ k))
   )
  )
 )
 (setvar "osmode" os)
(princ)
)

;-------------------------------------------------------------------------

;; 선택객체를 왼쪽부터... 정렬이 되게 하는 루틴

(defun @ss_new_lst_x (ss / ssn n ss-y1 en en1y ss-y2 ss-y3) ;선택정렬
   (setq ssn (sslength ss))
   (setq n 0)
   (setq ss-y1 '())
   (repeat ssn
       (setq en (ssname ss n))
       (setq en1y (list en (car (cdr (assoc 10 (entget en)) ) ) ))
       (setq ss-y1 (cons en1y ss-y1))
       (setq n (+ n 1))
   )
   (setq ss-y2 (vl-sort ss-y1 '(lambda (e1 e2) (< (cadr e1) (cadr e2))))  )
   (setq n 0 ss-y3 (ssadd))
   (repeat ssn
      (setq ss-y3 (ssadd (car (nth n ss-y2)) ss-y3))
      (setq n (+ n 1))
   )
ss-y3
)

;; 텍스트 중복선택한것을...왼쪽부터..정렬이 되게 하기 위함 루틴
(defun @ss_new_lst_11 (ss / ssn n ss-y1 en en1y ss-y2 ss-y3) ;선택정렬
   (setq ssn (sslength ss))
   (setq n 0)
   (setq ss-y1 '())
   (repeat ssn
       (setq en (ssname ss n))
       (setq en1y (list en (car (cdr (assoc 11 (entget en)) ) ) ))
       (setq ss-y1 (cons en1y ss-y1))
       (setq n (+ n 1))
   )
   (setq ss-y2 (vl-sort ss-y1 '(lambda (e1 e2) (< (cadr e1) (cadr e2))))  )
   (setq n 0 ss-y3 (ssadd))
   (repeat ssn
      (setq ss-y3 (ssadd (car (nth n ss-y2)) ss-y3))
      (setq n (+ n 1))
   )
ss-y3
)

;; 글짜폭을 0.6 으로 변경하기 위함 루틴

(defun tw(ss / k ntw1 ed tw)
  (setq k 0)
  (setq ntw1 0.6)
  (repeat (sslength ss)
    (setq ed (entget (ssname ss k))
          tw (cdr (assoc 41 ed)))
    (entmod (subst (cons 41 ntw1) (assoc 41 ed) ed))
    (setq k (1+ k))
  );repeat
(princ)
)

[별지기]

ㅎㅎㅎ....감사감사^^

[3:16]

와~~하루님..또 한번의 열강을 하셨네요^^* 언제나 감사하게 생각한다는...ㅎㅎㅎ

[doolycth]

하루님 전에 제가 요청해서 만들어 주셨는데 에러가 좀 있는듯 해서 말씀하셨듯 리습공부를 해서 어떻게 주물러 보려는데 힘드네요^^ 그래도 계속 관심가지면 할 수 있으리라 믿고 다른분들도 상당히 필요한것 같군요... 위에 예제를 봐도 아직 이해가 안되고 조금씩 보고 찾아 보면 이해 할 수 있겠죠? ^^

[최재영1]

정말 감사합니다 하루님!!!

[동동파파]

열공에 도움 주셔서 감사 합니다^^