1000도엽을 500으로 잘라주는 리습인데요.
파일이 4개가 생긴다고 알고있는데 도대체 생기질 않습니다..
도움부탁드립니다.
;;;Created by Ju in hoe, in Seoul
;;;2002.1.28
;;; 1:1000 —-> 1:500 ;4개의 도곽으로 잘라낸다.(어떤도곽이라도 4등분함)
;;; 현재 작업중인 디렉토리에 새로운 4개의 DWG생성.
;;; 예) 3712345.dwg —-> 3712345_1.dwg
;;; 3712345_2.dwg
;;; 3712345_3.dwg
;;; 3712345_4.dwg
;;;명령어 – KT
(defun ErrHandle (Err)
(if (and (/= Err “quit / exit abort”)
(/= Err “Function cancelled”)
)
(princ Err)
)
(setvar “cmddia” 1)
(setvar “osmode” osnap_mode)
(setq *error* OldError)
(princ)
)
(defun Get_PolyVtx (EntList / x VtxList AA)
(setq VtxList ‘())
(cond
((= “LWPOLYLINE” (CDR (ASSOC 0 EntList)))
(foreach x EntList
(if (= (car x) 10)
(setq VtxList (append VtxList (list (cdr x))))
)
)
)
((= “POLYLINE” (CDR (ASSOC 0 EntList)))
(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 inner_func (x1 x2 x3 x4 y1 y2 y3 y4)
;;; Upper Left —> no1
;;; Lower Left —> no2
;;; Upper Right —> no3
;;; Lower Right —> no4
(if (< (abs (- x1 x2)) 5)
(progn
(if (< x1 x3)
(progn
(if (> y1 y2)
(progn
(setq no1 1)
(setq no2 2)
)
(progn
(setq no1 2)
(setq no2 1)
)
)
(if (> y3 y4)
(progn
(setq no3 3)
(setq no4 4)
)
(progn
(setq no3 4)
(setq no4 3)
)
)
)
(progn
(if (> y3 y4)
(progn
(setq no1 3)
(setq no2 4)
)
(progn
(setq no1 4)
(setq no2 3)
)
)
(if (> y1 y2)
(progn
(setq no3 1)
(setq no4 2)
)
(progn
(setq no3 2)
(setq no4 1)
)
)
)
)
)
(progn
(if (< (abs (- x1 x3)) 5)
(progn
(if (< x1 x2)
(progn
(if (> y1 y3)
(progn
(setq no1 1)
(setq no2 2)
)
(progn
(setq no1 3)
(setq no2 1)
)
)
(if (> y2 y4)
(progn
(setq no3 2)
(setq no4 4)
)
(progn
(setq no3 4)
(setq no4 2)
)
)
)
(progn
(if (> y2 y4)
(progn
(setq no1 2)
(setq no2 4)
)
(progn
(setq no1 4)
(setq no2 2)
)
)
(if (> y1 y3)
(progn
(setq no3 1)
(setq no4 3)
)
(progn
(setq no3 3)
(setq no4 1)
)
)
)
)
)
(progn
(if (< x1 x2)
(progn
(if (> y1 y4)
(progn
(setq no1 1)
(setq no2 4)
)
(progn
(setq no1 4)
(setq no2 1)
)
)
(if (> y2 y3)
(progn
(setq no3 2)
(setq no4 3)
)
(progn
(setq no3 3)
(setq no4 2)
)
)
)
(progn
(if (> y2 y3)
(progn
(setq no1 2)
(setq no2 3)
)
(progn
(setq no1 3)
(setq no2 2)
)
)
(if (> y1 y4)
(progn
(setq no3 1)
(setq no4 4)
)
(progn
(setq no3 4)
(setq no4 1)
)
)
)
)
)
)
)
)
)
(defun dtr (a)
(setq x (* pi (/ a 180.0)))
)
(defun rtd (a)
(setq x (/ (* a 180) pi))
)
(defun entmake_text (string point size ang)
(entmake (list (cons 0 “TEXT”)
(cons 1 string)
(cons 8 “ZC601”)
(cons 10 point)
(cons 40 size)
(cons 50 ang)
)
)
)
(defun write_cord (dog_list)
(setvar “osmode” 0)
(setq ms 1)
; Upper Left TEXT
(setq pa_1 (nth 0 dog_list))
(setq pa_1x (car pa_1))
(setq pa_1y (cadr pa_1))
(setq ulx (list (- pa_1x (* ms 9)) pa_1y))
(setq uly (list pa_1x (+ pa_1y (* ms 9))))
(setq tpa_1x (rtos pa_1x 2 2))
(setq tpa_1y (rtos pa_1y 2 2))
(entmake_text tpa_1y ulx ms (dtr 0))
(entmake_text tpa_1x uly ms (dtr 270))
; Upper Right TEXT
(setq pb_1 (nth 1 dog_list))
(setq pb_1x (car pb_1))
(setq pb_1y (cadr pb_1))
(setq urx (list (+ pb_1x ms) pb_1y))
(setq ury (list pb_1x (+ pb_1y (* ms 9))))
(setq tpb_1x (rtos pb_1x 2 2))
(setq tpb_1y (rtos pb_1y 2 2))
(entmake_text tpb_1y urx ms (dtr 0))
(entmake_text tpb_1x ury ms (dtr 270))
; Lower Right TEXT
(setq pc_1 (nth 2 dog_list))
(setq pc_1x (car pc_1))
(setq pc_1y (cadr pc_1))
(setq lrx (list (+ pc_1x ms) pc_1y))
(setq lry (list pc_1x (- pc_1y ms)))
(setq tpc_1x (rtos pc_1x 2 2))
(setq tpc_1y (rtos pc_1y 2 2))
(entmake_text tpc_1y lrx ms (dtr 0))
(entmake_text tpc_1x lry ms (dtr 270))
; Lower Left TEXT
(setq pd_1 (nth 3 dog_list))
(setq pd_1x (car pd_1))
(setq pd_1y (cadr pd_1))
(setq llx (list (- pd_1x (* ms 9)) pd_1y))
(setq lly (list pd_1x (- pd_1y ms)))
(setq tpd_1x (rtos pd_1x 2 2))
(setq tpd_1y (rtos pd_1y 2 2))
(entmake_text tpd_1y llx ms (dtr 0))
(entmake_text tpd_1x lly ms (dtr 270))
(setq dokx (car (nth 1 dog_list)))
(setq doky (cadr (nth 1 dog_list)))
(setq te “”)
(setq dokxy (list (- dokx (+ (/ 213 2) 20)) (+ 1 doky)))
(entmake (list (cons 0 “TEXT”)
(cons 1 “”)
(cons 8 “ZC601”)
(cons 10 dokxy)
(cons 40 5)
)
)
(setq pbx (car (nth 1 dog_list)))
(setq pby (cadr (nth 1 dog_list)))
(setq dokxy1 (list (- pbx 65) (+ pby 1.8)))
(setq DP (getvar “DWGPREFIX”))
(setq dwgname (getvar “dwgname”))
(setq name (substr dwgname 1 (- (strlen dwgname) 4)))
(setq new_dwgname (strcat name name_no))
(setq full_path (strcat dp new_dwgname))
(entmake (list (cons 0 “TEXT”)
(cons 1 new_dwgname)
(cons 8 “ZC601”)
(cons 10 dokxy1)
(cons 40 5)
)
)
)
(defun c:kt (/ en poly_type poly_layer VtxList_dokak
a b c d ab bc cd da
r_ab r_bc r_cd r_da x1 x2 x3 x4
y1 y2 y3 y4 pa pb pc pd
dog_1 dog_2 dog_3 dog_4 mu mr md ml
cen
)
(setq OldError *error*)
(setq *error* ErrHandle)
(setvar “cmdecho” 0)
(setvar “cmddia” 0)
(setq osnap_mode (getvar “osmode”))
(setvar “osmode” 0)
(setq en (car (entsel “n도곽선택: “)))
(if (null en)
(prompt “nNo object selected.”)
(progn
(setq poly_type (cdr (assoc 0 (entget en))))
(setq poly_layer (strcase (cdr (assoc 8 (entget en)))))
(if (and (/= poly_type “POLYLINE”) (/= poly_type “LWPOLYLINE”))
(progn
(prompt “nERROR: Object selected is not a pline.”)
(setq en nil)
)
(progn
(if (/= poly_layer “ZD001”)
(progn
(princ “n 도곽레어어가 아닙니다.”)
(setq en nil)
)
)
)
)
)
)
(if en
(progn
(setq VtxList_dokak (Get_PolyVtx (entget en)))
(if (or (= (length VtxList_dokak) 4)
(= (length VtxList_dokak) 5)
)
(progn
(setq x1 (car (nth 0 VtxList_dokak)))
(setq x2 (car (nth 1 VtxList_dokak)))
(setq x3 (car (nth 2 VtxList_dokak)))
(setq x4 (car (nth 3 VtxList_dokak)))
(setq y1 (cadr (nth 0 VtxList_dokak)))
(setq y2 (cadr (nth 1 VtxList_dokak)))
(setq y3 (cadr (nth 2 VtxList_dokak)))
(setq y4 (cadr (nth 3 VtxList_dokak)))
(inner_func x1 x2 x3 x4 y1 y2 y3 y4)
;;; Upper Left —> pa
;;; Upper Right —> pb
;;; Lower Right —> pc
;;; Lower Left —> pd
(setq pa (nth (- no1 1) VtxList_dokak))
(setq pb (nth (- no3 1) VtxList_dokak))
(setq pc (nth (- no4 1) VtxList_dokak))
(setq pd (nth (- no2 1) VtxList_dokak))
(find_mid_pt)
(setq dog_1 (list pa mu cen ml))
(trim_func dog_1 “A”)
(command “u”)
(setq dog_2 (list mu pb mr cen))
(trim_func dog_2 “B”)
(command “u”)
(setq dog_3 (list ml cen md pd))
(trim_func dog_3 “C”)
(command “u”)
(setq dog_4 (list cen mr pc md))
(trim_func dog_4 “D”)
(command “u”)
)
(progn
(princ “n 도곽이 아닙니다. “)
)
)
)
)
(setvar “osmode” osnap_mode)
(setvar “cmddia” 1)
(princ “n Completed…………… ^|~;; “)
(princ)
)
(defun find_mid_pt (/ pax pay pbx pby pcx pdy)
(setq pax (car pa))
(setq pay (cadr pa))
(setq pbx (car pb))
(setq pby (cadr pb))
(setq pcx (car pc))
(setq pcy (cadr pc))
(setq pdx (car pd))
(setq pdy (cadr pd))
(setq mu (list (/ (+ pax pbx) 2) (/ (+ pay pby) 2)))
(setq mr (list (/ (+ pbx pcx) 2) (/ (+ pby pcy) 2)))
(setq md (list (/ (+ pcx pdx) 2) (/ (+ pcy pdy) 2)))
(setq ml (list (/ (+ pdx pax) 2) (/ (+ pdy pay) 2)))
(setq cen (inters mu md ml mr))
)
(defun trim_func (dog_list name_no / org_dog
BOUND entname 14_ver_ss version
doyup_ptx0 doyup_pty0 doyup_ptx- doyup_pty+
doyup_pt DP dwgname name
new_dwgname full_path choice
)
(command “undo” “be”)
(setq org_dog
(ssget “X”
(list
(cons 8 “ZD001”)
)
)
)
(command “erase” org_dog “”)
(command “layer” “m” “ZD001” “s” “ZD001” “”)
(command “pline”)
(foreach n dog_list (command n))
(command “c”)
(setq BOUND
(ssget “X”
(list
(cons 8 “ZD001”)
)
)
)
(setq entname (ssname BOUND 0))
(setq 14_ver_ss (list entname ‘(0 0 0)))
(setq version (ver))
(cond
((equal version “Visual LISP 2000 (en)”)
(command “maptrim” “s” BOUND “n” “n” “o” “n” “n” “i” “y”)
)
((equal version “AutoLISP Release 14.0 (en)”)
(command “maptrim” “s” 14_ver_ss “n” “n” “o” “n” “n” “i” “y”)
)
)
(write_cord dog_list)
(command “zoom” “e”)
(princ “n “)
(princ (strcat new_dwgname “.dwg”))
(if (findfile (strcat new_dwgname “.dwg”))
(progn
(initget “Y N”)
(princ ” — 파일이 존재합니다.”)
(setq choice (getkword “n 덮어 쓸까요 y/n [y]: “))
(cond
((= choice “N”)
(progn
(cond
((equal version “Visual LISP 2000 (en)”)
(command “wblock” full_path “n”)
)
((equal version “AutoLISP Release 14.0 (en)”)
(command “wblock” full_path “n”)
)
)
)
)
(T
(progn
(cond
((equal version “Visual LISP 2000 (en)”)
(command “wblock” full_path “y” “*” “n”)
)
((equal version “AutoLISP Release 14.0 (en)”)
(command “wblock” full_path “y” “*”)
)
)
)
)
)
)
(progn
(cond
((equal version “Visual LISP 2000 (en)”)
(command “wblock” full_path “*” “n”)
)
((equal version “AutoLISP Release 14.0 (en)”)
(command “wblock” full_path “*”)
)
)
)
)
(command “undo” “e”)
)