1000도엽 500도엽으로 분할 리습인데 사용이 안되네요
저는 ZWCAD 2024 쓰고 있습니다
고수님들 무엇때문인지…사용가능한건지 한번만 봐주세요ㅠㅠ
;;;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
path : 실행파일위치저장, tic좌표생성
;;;명령어 – 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 dokxy1 (list (+ (- pbx 65) 10) (+ 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)
;; )
;; )
;; (if(= title_name “”)
;; ()
;; (progn
;; (setq dokxy1 (list (- (- pbx 65) 65.4767) (+ pby 1.8 0.6753)))
;; (entmake (list (cons 0 “TEXT”)
;; (cons 1 title_name)
;; (cons 8 “ZC601”)
;; (cons 10 dokxy1)
;; (cons 40 5)
;; )
;; )
;; )
;; )
)
(defun c:kt (/ en poly_type poly_layer VtxList_dokak
a b c d abbc cd da
r_ab r_bc r_cd r_da x1x2 x3 x4
y1 y2 y3 y4 papb pc pd
dog_1 dog_2 dog_3 dog_4 mumr md ml
cen
)
(setq OldError *error*)
(setq *error* ErrHandle)
(setvar “cmdecho” 0)
(setvar “cmddia” 0)
(setq osnap_mode (getvar “osmode”))
;===================================
(terpri)
;(textscr)
;(setq title_name (getstring T “\\n타이틀명:”))
(setq title_name “천 안 시”)
;(graphscr)
;===================================
(setvar “osmode” 0)
;(setq en (car (entsel “\\n도곽선택: “)))
(setq en (ssname (ssget “x”(list(cons 8 “ZD001,H0017334”))) 0))
(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(and (/= poly_layer “ZD001”) (/= poly_layer “H0017334”))
(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))
(if(setq en1 (ssget “x”(list(cons 8 “ZC601”)(cons 40 1.2))))
(command “erase” en1 “”)
)
(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,ZC601,H0017334,H0010601”)
)
)
)
(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,H0017334”)
)
)
)
(setq entname (ssname BOUND 0))
(setq 14_ver_ss (list entname ‘(0 0 0)))
(setq version (ver))
(cond
((equal version “Visual LISP 2004 (en)”)
(command “maptrim” “s” BOUND “n” “n” “o” “n” “n” “i” “y”)
)
((equal version “Visual LISP 2016 (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)
(princ “\\n “)
;;야장출력폼 자동삽입
(setq ins_path “C:\\\\손동만\\\\자료\\\\li\\\\GIS_LISP”)
(setq ins_file_nm “야장_base.dwg”)
(setq ins_path_file (strcat “*” ins_path ins_file_nm))
(setq ins_po (cdr(assoc 10 (entget(ssname (ssget “x”(list(cons 8 “ZD001,H0017334”)(cons 0 “*LINE”))) 0)))))
(command “insert” ins_path_file ins_po “” “” “0”)
(if(setq dwg_set (ssget “x”(list(cons 8 “ZC601”)(cons 1 “000000000A”))))
(progn
(setq dwg_list (entget(ssname dwg_set 0)))
(setq new_list (subst (cons 1 new_dwgname) (assoc 1 dwg_list) dwg_list))
(entmod new_list)
)
)
(command “zoom” “e”)
(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 2004 (en)”)
(command “wblock” full_path “n”)
)
((equal version “Visual LISP 2016 (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 2004 (en)”)
(command “wblock” full_path “y” “*” “n”)
)
((equal version “Visual LISP 2016 (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 2004 (en)”)
(command “wblock” full_path “*” “n”)
)
((equal version “Visual LISP 2016 (en)”)
(command “wblock” full_path “*” “n”)
)
((equal version “AutoLISP Release 14.0 (en)”)
(command “wblock” full_path “*”)
)
)
)
)
(command “undo” “e”)
)
(defun c:ch_t()
(setvar “cmdecho” 0)
(setq find_txt “하 수 1:500”)
(setq replace_txt “상 수 1:500”)
(if(setq ss_set (ssget “x”(list(cons 1 find_txt))))
(progn
(setq n 0 m (sslength ss_set))
(while(< n m)
(setq ent_nm (ssname ss_set n))
(setq ent_list (entget ent_nm))
(setq ent_txt (cdr(assoc 1 ent_list)))
(setq new_list (subst (cons 1 replace_txt) (assoc 1 ent_list) ent_list))
(entmod new_list)
(setq n (1+ n))
)
)
)
(princ)
)
(princ)