CAFE

★ CAD/LISP/분과 Q&A

[[Lisp]]쉐입파일에서 필드값을 추출하여 텍스트를 도면에 뿌리는 리습 수정건입니다

작성자회탈리카|작성시간09.06.23|조회수667 목록 댓글 4

 

※성심 성의껏 질문을 작성하여 주세요, 대충하시면 답변도 대충작성합니다.^^

① CAD 종류   : 맵

② VERSION   : 2009

③ 분           : gis

④ 파일  첨부  :

첨부파일 DTT(속성ID추출)2.LSP

 

첨부파일 1.rar

 

⑤ 질문  내용  : 

예전에 권대리 님이 만드신 리습입니다.리습이 돌지가 않아서 수정을 부탁드립니다.일단 샘플쉐입은 1이라는 파일명으로 압축해서 올렸습니다.지금현재 문제점은 쉐입을 하나만 열고 작업하면 잘도는것입니다.하지만 여러개의 쉐입을 한꺼번에 열고 돌리면 굉장히 오랜시간이 걸리고 또한 오랜시간이 걸리다가 잘못된 인수 유형이라고 나옵니다.작동을 안하는거죠.

저희 gis는 쉐입이 통짜파일도 있지만 여러테이블로 나누어져 있는경우가 많기 때문에 여러쉐입을 한번에 속성을 텍스트로 뿌려졌으면합니다.

반드시 실험은 제가 첨부로 올린 1.rar을 이용해서 해주십시요 

 

 

 

 

 

 

 

 

 

;2009.1.22.Edit by Kwon.(아키모아)
;http://cafe.daum.net/archimore
;2D Polyline이 있는 경우 Lwpolyline으로 변환 후 실행
;Polygon 안의 Polygon 존재 (Hole Poly) => 필드값 비교 후 같으면 속성 입력 않함.
;실행 명령 : dtt => 속성 입력
;            att => 속성 재선택
;입력 오류 객체 => "Att_err" Layer Circle 확인
(prompt "\n속성 필드값 입력 =>> dtt [Enter]\n")
(prompt "\n입력하려는 필드값 재설정 =>> att [Enter]\n")
;========================================================================================
(VL-LOAD-COM)
(defun dtr (a) (* pi (/ a 180.0)))          ;degree to radian
(defun rtd (a) (/ (* a 180.0) pi))          ;radian to degree
(defun KS();현재 설정값 기억 및 리셋
  (setq getv (list "edgemode" "filedia" "coords" "blipmode" "ucsicon" "regenmode" "plinetype" "plinegen"
                   "bindtype" "sdi" "expert" "snapang" "orthomode" "osmode" "clayer" "cmdecho")
        setv (mapcar 'getvar getv)))
(KS)
(defun KE();기억된 설정값 리콜
  (mapcar 'setvar getv setv)(princ))
(defun *error*(errmsg);실행중 취소시 기억된 설정값 리콜
  (if (not (member errmsg '("Function cancelled" "quit / exit abort" "console break" "")))
    (if (zerop (getvar "errno"))
      (progn (princ "\n") (princ errmsg))
      (progn (princ "ErrNo ") (princ (getvar "errno")) (princ": ") (princ errmsg))))
  (if KS (mapcar 'setvar getv setv)))
;========================================================================================
(defun GETPOLYVTX(entlist / vtxlist aa x) ; 폴리라인 XY좌표 리스트(2차원) http://xoutside.com/ 김희태님 소스
  (setq vtxlist '())
  (if (= "LWPOLYLINE" (cdr (assoc 0 entlist)))
   (mapcar '(lambda (x) (if (= 10 (car x)) (setq vtxlist (append vtxlist (list (cdr x))) ) ) ) entlist)
   (progn
    (setq aa (entget(entnext (cdr (assoc -1 entlist)))))
    (while (/= "SEQEND" (cdr (assoc 0 aa)))
      (setq vtxlist (append vtxlist (list (cdr (assoc 10 aa)))))
      (setq aa (entget(entnext (cdr (assoc -1 aa))))))))
  vtxlist
)
;========================================================================================
(defun GET_EXTEND(xy_list / mx my nx ny) ; Entity내의 최대 확장 Box구하기(2차원) http://cafe.naver.com/opengis 라이거님 소스
  (setq nx (apply 'min (mapcar 'car xy_list))
        mx (apply 'max (mapcar 'car xy_list))
        ny (apply 'min (mapcar 'cadr xy_list))
        my (apply 'max (mapcar 'cadr xy_list)))
  (list (list nx ny) (list mx my))
)
;========================================================================================
;;; 무게중심이 아닌 면의 안쪽 중심점 - 레이블 포지션 http://cafe.naver.com/opengis 라이거님 소스
(defun LABEL_PT(xy_list / extend maxxy minxy my sp ep msp mep flag di_list max_dist mid)
  (setq extend (GET_EXTEND xy_list)
        minxy (car extend)
        maxxy (cadr extend)
        my (/ (+ (cadr minxy) (cadr maxxy)) 2.0)
        msp (list (car minxy) my)
        mep (list (car maxxy) my)
        xy_list (if (equal (car xy_list) (last xy_list))
                  xy_list (append xy_list (list (car xy_list))))
        sp (car xy_list))
  (foreach ep (cdr xy_list)
    (if (setq flag (inters msp mep sp ep))
      (if (null (member flag di_list))
        (setq di_list (append di_list (list (distance msp flag))))))
    (setq sp ep))
  (while (cdr di_list)
    (if (<= max_dist (setq flag (- (cadr di_list) (car di_list))))
      (setq max_dist flag
            mid (/ (+ (cadr di_list) (car di_list)) 2.0)))
    (setq di_list (cddr di_list)))
  (list (+ (car minxy) mid) my)
)
;========================================================================================
(defun CONTAIN_P(xy xy_list / sp ep extxy p flag) ; 임의의 점이 도형의 내부, 접선, 외부 판정, 결과값 => 내부 = -1, 접선 = 0, 외부 = 1 http://cafe.naver.com/opengis 라이거님 소스
  (setq xy_list (if (equal (car xy_list) (last xy_list)) xy_list (append xy_list (list (car xy_list))))
        sp (car xy_list)
        p 0
        extxy 0)
  (mapcar '(lambda(x) (setq extxy (+ extxy (+ (abs (car x)) (abs (cadr x)))))) xy_list)
  (setq extxy (list extxy extxy))
  (foreach ep xy_list
    (setq p (if (inters sp ep xy extxy) (1+ p) p)
          flag (if (= (rtos (distance sp ep) 2 11) (rtos (+ (distance sp xy) (distance xy ep)) 2 11)) 0 flag)
          sp ep))
  (if flag
    0
    (if (= (rem p 2) 1) -1 1))
)
;========================================================================================
(defun sss0()
  (setq ss-n (sslength ss)
        ssn 0 vn 0)
  (repeat ss-n
    (setq a0 (ssname ss ssn)
          a00 (entget a0)
          a01 (cdr (assoc 0 a00))
          a02 (cdr (assoc 8 a00))
          a03 (cdr (assoc 10 a00))
          ab (car (ade_odgettables a0)))
    (if ab
      (progn
        (setq ab1 (ade_odtabledefn ab)
              ab2 (nth 2 ab1)
              Table-List (mapcar '(lambda (x) (cdr (car x))) (cdr ab2)))
        (if (= (vl-position name Table-List) nil)
          (progn
            (setq tl-n (vl-list-length Table-List)
                  tln 1
                  tl-h3 '() tl-k0 '()
                  tl-hh "0")
            (repeat tl-n
              (setq tl-h (rtos tln 2 0)
                    tl-h2 (strcat "(" tl-h ")")
                    tl-h3 (cons tl-h2 tl-h3)
                    tl-k0 (cons tl-h tl-k0)
                    tl-hh (strcat tl-hh " " tl-h)
                    tln (+ tln 1))
            );repeat
            (setq tl-h3 (reverse tl-h3)
                  tl-k0 (reverse tl-k0)
                  tl-hh (substr tl-hh 3))
            (initget 1 tl-hh)
            (setq getkey0 (mapcar 'strcat Table-List tl-h3)
                  getkeyn (vl-list-length getkey0)
                  gn 0
                  getkey-A "")
            (repeat getkeyn
              (setq getkey1 (nth gn getkey0)
                    getkey-A (strcat getkey-A getkey1 ", ")
                    gn (+ gn 1))
            );repeat
            (setq getkey-L (strlen getkey-A)
                  getkey-N0 (strcat (substr getkey-A 1 (- getkey-L 2)) " : ")
                  getkey-N1 (strcat "<<" a02 ">>")
                  getkey-N2 " 속성 키워드 입력. "
                  getkey-N3 (strcat getkey-N1 getkey-N2 getkey-N0)
                  kword0 (getkword getkey-N3)
                  kword1 (atoi kword0)
                  name (nth (- kword1 1) Table-List))
          );progn
        );if
        (setq a2 (ade_odgetrecord a0 ab 0))
        (if a2
          (progn
            (if (or (= a01 "POINT") (= a01 "INSERT") (= a01 "CIRCLE") (= a01 "ARC"))
              (progn
                (setq aaa a03
                      lay name
                      odi name)
              );progn
            );if
            (if (= a01 "LWPOLYLINE")
              (progn
                (setq ver-00 (getpolyvtx a00)
                      ver-00 (reverse ver-00)
                      StartPoint (car ver-00)
                      EndPoint (last ver-00)
                      IsClosed (cdr (assoc 70 a00))
                      ver-nn (vl-list-length ver-00)
                      ver-n0 (/ ver-nn 2)
                      po-1 (nth (- ver-n0 1) ver-00)
                      po-2 (nth ver-n0 ver-00))
                (if (or (equal StartPoint EndPoint) (equal IsClosed 1))
                  (setq polyyn "Y")
                  (setq polyyn "N")
                );if
                (pl-li)
              );progn
            );if
            (if (= a01 "LINE")
              (progn
                (setq po-1 (cdr (assoc 10 a00))
                      po-2 (cdr (assoc 11 a00)))
                (pl-li)
              );progn
            );if
            (setq aaa1 (ade_odgetrecfield a2 odi))
            (if (/= aaa1 "")
              (progn
                (if (= polyyn "Y")
                  (progn
                    (setq aaa1 (ade_odgetrecfield a2 odi)
                          aaa-x (nth 0 aaa)
                          aaa-y (nth 1 aaa)
                          aaa-xy0 (list aaa-x (- aaa-y 2)))
                    (if (or (= (tblsearch "layer" lay) nil) (/= clayer lay))
                      (progn
                        (if (/= (tblsearch "layer" lay) nil)
                          (vl-cmdf "layer" "t" lay "")
                        );if
                        (vl-cmdf "layer" "m" lay "c" "2" lay "")
                        (setq clayer (getvar "clayer"))
                      );progn
                      (progn
                        (vl-cmdf "layer" "t" lay "")
                        (setvar "clayer" lay)
                      );progn
                    );if
                    (vl-cmdf "style" "NGSW" "romans,ngsw" 0 1 0 "n" "n" "n" "text" "j" "mc" aaa "1" "0" aaa1)
                    (setq las-0 (ssget "L"))
                    (vl-cmdf "chprop" las-0 "" "c" "2" "")
                  );progn
                  (progn
                    (setq aaa1 (ade_odgetrecfield a2 odi))
                    (if (or (= (tblsearch "layer" lay) nil) (/= clayer lay))
                      (progn
                        (if (/= (tblsearch "layer" lay) nil)
                          (vl-cmdf "layer" "t" lay "")
                        );if
                        (vl-cmdf "layer" "m" lay "c" "2" lay "")
                        (setq clayer (getvar "clayer"))
                      );progn
                      (progn
                        (vl-cmdf "layer" "t" lay "")
                        (setvar "clayer" lay)
                      );progn
                    );if
                    (if (or (= a01 "POINT") (= a01 "INSERT") (= a01 "CIRCLE") (= a01 "ARC"))
                      (progn
                        (vl-cmdf "style" "NGSW" "romans,ngsw" 0 1 0 "n" "n" "n" "text" "j" "mc" aaa "1" "0" aaa1)
                      );progn
                      (progn
                        (vl-cmdf "style" "NGSW" "romans,ngsw" 0 1 0 "n" "n" "n" "text" "j" "mc" aaa "1" po-ang-1 aaa1)
                      );progn
                    );if
                    (setq las-0 (ssget "L"))
                    (vl-cmdf "chprop" las-0 "" "c" "2" "")
                  );progn
                );if
              );progn
       (progn
                (if (= (tblsearch "layer" "Att_err") nil)
                  (progn
                    (vl-cmdf "layer" "m" "Att_err" "c" "6" "Att_err" "")
                  );progn
                  (progn
                    (if (/= clayer "Att_err")
                      (setvar "clayer" "Att_err")
                    );if
                  );progn
                )
  (vl-cmdf "circle" a03 "5")
  (setq vn (1+ vn))
       );progn
            );if
            (vl-cmdf "chprop" a0 "" "c" "1" "")
          );progn
          (progn
            (if (= (tblsearch "layer" "Att_err") nil)
              (progn
                (vl-cmdf "layer" "m" "Att_err" "c" "6" "Att_err" "")
              );progn
              (progn
                (if (/= clayer "Att_err")
                  (setvar "clayer" "Att_err")
                );if
              );progn
            );if
            (vl-cmdf "circle" a03 "5")
     (setq vn (1+ vn))
          );progn
        );if
      );progn
      (progn
        (if (= (tblsearch "layer" "Att_err") nil)
          (progn
            (vl-cmdf "layer" "m" "Att_err" "c" "6" "Att_err" "")
          );progn
          (progn
            (if (/= clayer "Att_err")
              (setvar "clayer" "Att_err")
            );if
          );progn
        )
        (vl-cmdf "circle" a03 "5")
        (setq vn (1+ vn))
      );progn
    );if
    (setq ssn (+ ssn 1))
    (princ (strcat "\r" (itoa ss-n) " / " (itoa ssn) " : " (itoa vn) "개 확인하세요."))
  );repeat
  (princ)
);defun sss0
;========================================================================================
(defun pl-li()
  (setq po-dis (distance po-1 po-2)
        po-ang (angle po-1 po-2)
        po-dis-1 (/ po-dis 2)
        po-ang-1 (rtd po-ang))
  (if (= polyyn "Y")
    (progn
      (setq a04 (list a0 a03)
            lay name
            odi name
            aaa (LABEL_PT ver-00))
    );progn
    (progn
      (setq aaa (polar po-1 (dtr po-ang-1) po-dis-1)
            lay name
            odi name)
    );progn
  );if
);defun pl-li
;========================================================================================
(defun c:dtt(/ aa ss vn vn1 vn-pl vn-00 vn-01 vn-02 vn-bp vn-li vn-cr vn-pln pl00-1 pl00-2 xy1 xy2 ver-01 ab ab-1 ab-2 ab-11 ab-12 ab-21
             ab-22 aab1 aab2 Tbl vpn ss_n a0 a00 a01 a02 a03 a04 a2 odi ver-00 ver-nn ver-n0 po-1 po-2 po-dis po-ang po-dis-1 po-ang-1 aaa
             aaa1 ss-n ssn ab1 ab2 Table-List Table-List-1 Table-List-2 tl-n tln tl-h3 tl-k0 tl-hh tl-h tl-h2 getkey0 getkeyn gn getkey-L
             getkey-N0 getkey-N1 getkey-N2 getkey-N3 kword0 kword1 aaa-x aaa-y aaa-xy0 las-0 vn-cir StartPoint EndPoint IsClosed)
  (vl-cmdf "undo" "be")
  (setq aa (ade_odtablelist))
  (if aa
    (progn
      (setvar "cmdecho" 0)(setvar "osmode" 0)(setvar "orthomode" 0)
      (setq ss (ssget '((-4 . "<NOT")(0 . "TEXT")(-4 . "NOT>"))));TEXT 제외
      (if ss
        (progn
          (setq vn1 0
                vn-pl (ssadd) vn-bp (ssadd) vn-te (ssadd) vn-li (ssadd) vn-cr (ssadd)
                ss_n (sslength ss))
          (repeat ss_n
            (setq vn-00 (ssname ss vn1)
                  vn-01 (entget vn-00)
                  vn-02 (cdr (assoc 0 vn-01)))
            (if (= vn-02 "LWPOLYLINE")
              (progn
                (setq vn-pl (ssadd vn-00 vn-pl))))
            (if (or (= vn-02 "INSERT") (= vn-02 "POINT"))
              (progn
                (setq vn-bp (ssadd vn-00 vn-bp))))
            (if (= vn-02 "LINE")
              (progn
                (setq vn-li (ssadd vn-00 vn-li))))
            (if (or (= vn-02 "CIRCLE") (= vn-02 "ARC"))
              (progn
                (setq vn-cr (ssadd vn-00 vn-cr))))
            (setq vn1 (+ vn1 1))
          );repeat
          (setq vn-pln (sslength vn-pl) vn-bpn (sslength vn-bp) vn-ten (sslength vn-te) vn-lin (sslength vn-li) vn-cir (sslength vn-cr))
;===========================================================================================Polygon내 Polygon 필드값 비교 Start
          (if ( > vn-pln 1)
            (progn
              (repeat vn-pln
                (setq pl00-1 (ssname vn-pl 0)
                      xy1 (cdr (assoc 10 (entget pl00-1)))
                      ver-01 (getpolyvtx (entget pl00-1))
                      ab-1 (car (ade_odgettables pl00-1))
                      vn-pl (ssdel pl00-1 vn-pl)
                      vpn 0)
                (repeat (- vn-pln 1)
                  (setq pl00-2 (ssname vn-pl vpn)
                        xy2 (cdr (assoc 10 (entget pl00-2))))
                  (if (= (CONTAIN_P xy2 (getpolyvtx (entget pl00-1))) -1)
                    (progn
                      (setq ab-2 (car (ade_odgettables pl00-1)))
                      (if (and (/= ab-1 nil) (/= ab-2 nil) (equal ab-1 ab-2))
                        (progn
                          (setq ab-11 (ade_odtabledefn ab-1)
                                ab-12 (nth 2 ab-11)
                                Table-List-1 (mapcar '(lambda (x) (cdr (car x))) (cdr ab-12))
                                aab1 (ade_odgetrecord pl00-1 ab-1 0))
                          (setq ab-21 (ade_odtabledefn ab-2)
                                ab-22 (nth 2 ab-21)
                                Table-List-2 (mapcar '(lambda (x) (cdr (car x))) (cdr ab-22))
                                aab2 (ade_odgetrecord pl00-2 ab-2 0))
                          (setq Tbl (mapcar '(lambda (a b) (equal (ade_odgetrecfield aab1 a) (ade_odgetrecfield aab2 b))) Table-List-1 Table-List-2))
                          (if (/= (vl-position nil Tbl) nil)
                            (setq vn-pl (ssadd pl00-1 vn-pl))
                            (setq vn-pl (ssdel pl00-2 vn-pl)
                                  vn-pl (ssadd pl00-1 vn-pl)))
                        );progn
                      );if
                    );progn
                    (setq vn-pl (ssadd pl00-1 vn-pl))
                  );if
                  (setq vpn (1+ vpn))
                );repeat
              );repeat
            );progn
          );if
;===========================================================================================Polygon내 Polygon 필드값 비교 End
          (if (> vn-pln 0) (progn (setq ss vn-pl) (sss0)));polyline
          (if (> vn-bpn 0) (progn (setq ss vn-bp) (sss0)));point,block
          (if (> vn-lin 0) (progn (setq ss vn-li) (sss0)));line
          (if (> vn-cir 0) (progn (setq ss vn-cr) (sss0)));circle,arc
        );progn
        (princ "\n 객체를 선택하세요.")
      );if
    );progn
    (princ "\n 속성이 있는 객체가 없습니다.")
  );if
  (vl-cmdf "undo" "e") (KE)
  (princ)
);defun c:dtt
;===========================================================입력하려는 필드값 재설정
(defun c:att(/ aa ss ss-n ssn a0 a00 a01 a02 a03 ab ab1 ab2 Table-List tl-n tln tl-h3 tl-hh tl-h tl-h2 tl-k0 getkey0
             getkeyn gn getkey-A getkey1 getkey-L getkey-N0 getkey-N1 getkey-N2 getkey-N3 kword0 kword1)
  (setq aa (ade_odtablelist))
  (if aa
    (progn
      (setq ss (ssget))
      (if ss
        (progn
          (setq ss-n (sslength ss)
                ssn 0
                a0 (ssname ss ssn)
                a00 (entget a0)
                a01 (cdr (assoc 0 a00))
                a02 (cdr (assoc 8 a00))
                a03 (cdr (assoc 10 a00))
                ab (car (ade_odgettables a0))
                ab1 (ade_odtabledefn ab)
                ab2 (nth 2 ab1)
                Table-List (mapcar '(lambda (x) (cdr (car x))) (cdr ab2))
                tl-n (vl-list-length Table-List)
                tln 1
                tl-h3 '() tl-k0 '()
                tl-hh "0")
          (repeat tl-n
            (setq tl-h (rtos tln 2 0)
                  tl-h2 (strcat "(" tl-h ")")
                  tl-h3 (cons tl-h2 tl-h3)
                  tl-k0 (cons tl-h tl-k0)
                  tl-hh (strcat tl-hh " " tl-h)
                  tln (+ tln 1))
            );repeat
          (setq tl-h3 (reverse tl-h3)
                tl-k0 (reverse tl-k0)
                tl-hh (substr tl-hh 3))
          (initget 1 tl-hh)
          (setq getkey0 (mapcar 'strcat Table-List tl-h3)
                getkeyn (vl-list-length getkey0)
                gn 0
                getkey-A "")
          (repeat getkeyn
            (setq getkey1 (nth gn getkey0)
                  getkey-A (strcat getkey-A getkey1 ", ")
                  gn (+ gn 1))
          );repeat
          (setq getkey-L (strlen getkey-A)
                getkey-N0 (strcat (substr getkey-A 1 (- getkey-L 2)) " : ")
                getkey-N1 (strcat "<<" a02 ">>")
                getkey-N2 " 속성 키워드 입력. "
                getkey-N3 (strcat getkey-N1 getkey-N2 getkey-N0)
                kword0 (getkword getkey-N3)
                kword1 (atoi kword0)
                name (nth (- kword1 1) Table-List))
        );progn
        (princ "\n 객체를 선택하세요.")
      );if
    );progn
    (princ "\n 속성이 있는 객체가 없습니다.")
  );if
  (princ)
);defun c:att

 

⑥ Screenshot : 무

 

 

※ 유의사항

 - Screenshot : 이해를 돕기위해 삽입요망.

 - 파일 첨부 : 상위버전에서 테스트할 파일이 아니면 가급적 하위버전으로 저장후 첨부.

                       해당리습도 같이 첨부하여 주세요.

 -        목 : 질문 내용 반영(개략적인 내용),       예) 해치를 만들고 싶어요..

 - 질문글 삭제금지 : 질문후 댓글이 달린글은 삭제금지.

    여러 리플러들이 소중한 시간을 내어서 고민한후 댓글을 작성한 이상 "강력조치" 토록 하겠음. 

 

 

 

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

댓글

댓글 리스트
  • 삭제된 댓글입니다.
  • 답댓글 작성자회탈리카 작성자 본인 여부 작성자 | 작성시간 09.06.23 간단히 말해서 어느 선이 있습니다.예를들어 배관이 있다고 하죠.배관은 캐드에서 단순이 선으로 그리겠죠.이때 쉐입을 만들면서 그단순한 선안에속성을 넣는겁니다.그렇게 되면 결과는 이렇습니다.그배관인 선을 클릭하고 프리퍼티스 창을 띄우명 선의 속성에 배관 두께 배관길이 배관명 배관제조일자등등 이 나타납니다.물론 쉐입을 만들기 전에 엑셀로 배관에 관한 속성을 넣어두고 쉐입을 만들면서 테이블을 만들어서 이미만들어논 엑셀하고 조인을 시키면 각종선들이나 면에 속성값이 들어가는거죠.
  • 삭제된 댓글입니다.
  • 답댓글 작성자회탈리카 작성자 본인 여부 작성자 | 작성시간 09.06.23 일단 지금현재 선밖에 없는 것에 속성을 조인시켜야합니다.조인은 같이 있는 dbf파일을 선안에 다넣어주면되죠.그렇게 되면 각각의 선이나 면을 클릭하면 이선이무엇을 하는선인지 나타난답니다.캐드노하우에 비비대장님이 올리신 속성정보 텍스트로 뿌리기를 보시면 됩니다
댓글 전체보기
맨위로

카페 검색

카페 검색어 입력폼