DTT(속성ID추출)2.LSP;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))
(setq di_list (SORT di_list)
max_dist 0)
(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
;;;예전에 사와랑님께서 요청하셔서 만든건데 신규리습에 올린다고 해놓고 잊고 있었네요.^^;;
첨부파일첨부된 파일이 1개 있습니다.
다음검색