;;; 등분 자르기 - TORVA 무료 리습 (torva.kr/lisp.html)
;;; EQ : 선·폴리선을 N 등분으로 자른다. S 를 입력하면 간격 자르기 - 클릭한 끝에서부터 정한 길이마다 자른다
;;; EQC : 고른 객체를 시작점~끝점 사이에 N 등분 간격으로 복사한다
;;; 여러 객체를 한 번에 골라도 된다. 끝난 뒤 되돌리기(U) 한 번에 전부 돌아간다
(vl-load-com)
;; ent 를 시작에서부터 잰 거리 목록 dists 자리마다 끊는다 (먼 곳부터 끊어야 거리가 안 바뀐다)
(defun tv-divide-cut (ent dists / p)
(foreach d (vl-sort dists '>)
(if (setq p (vlax-curve-getPointAtDist ent d))
(progn
(setq p (trans p 0 1))
(command "_.BREAK" (list ent p) "_F" "_non" p "_non" p)))))
(defun tv-divide-len (ent) (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))
(defun c:EQ (/ *error* ce doc ss inp pick gap i ent len rev n j dists)
(setq ce (getvar "CMDECHO") doc (vla-get-activedocument (vlax-get-acad-object)))
(defun *error* (msg)
(setvar "CMDECHO" ce) (vla-EndUndoMark doc)
(if (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*")) (princ (strcat "\n오류: " msg)))
(princ))
(setvar "CMDECHO" 0)
(vla-StartUndoMark doc)
(princ "\n자를 선·폴리선 선택: ")
(if (setq ss (ssget '((0 . "LINE,LWPOLYLINE"))))
(progn
(initget 6 "S")
(setq inp (getint "\n등분 개수 [간격 자르기(S)]: "))
(cond
;; 간격 자르기 - 클릭한 쪽 끝에서부터 gap 마다
((= inp "S")
(if (and (setq pick (getpoint "\n시작할 끝 쪽을 클릭: "))
(setq gap (getdist "\n간격: ")))
(progn
(setq i 0)
(repeat (sslength ss)
(setq ent (ssname ss i) len (tv-divide-len ent) dists nil j 1
rev (> (vlax-curve-getDistAtPoint ent (vlax-curve-getClosestPointTo ent (trans pick 1 0))) (/ len 2.0))
n (fix (/ (- len 1e-6) gap)))
(repeat n
(setq dists (cons (if rev (- len (* j gap)) (* j gap)) dists) j (1+ j)))
(tv-divide-cut ent dists)
(setq i (1+ i)))
(princ (strcat "\n" (rtos gap 2 0) " 간격으로 잘랐습니다.")))))
;; 등분
((and inp (> inp 1))
(setq i 0)
(repeat (sslength ss)
(setq ent (ssname ss i) len (tv-divide-len ent) dists nil j 1)
(repeat (1- inp)
(setq dists (cons (* j (/ len inp)) dists) j (1+ j)))
(tv-divide-cut ent dists)
(setq i (1+ i)))
(princ (strcat "\n" (itoa inp) " 등분으로 잘랐습니다."))))))
(vla-EndUndoMark doc)
(setvar "CMDECHO" ce)
(princ)
)
(defun c:EQC (/ *error* ce doc ss p1 p2 n ang step k)
(setq ce (getvar "CMDECHO") doc (vla-get-activedocument (vlax-get-acad-object)))
(defun *error* (msg)
(setvar "CMDECHO" ce) (vla-EndUndoMark doc)
(if (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*")) (princ (strcat "\n오류: " msg)))
(princ))
(setvar "CMDECHO" 0)
(vla-StartUndoMark doc)
(princ "\n복사할 객체 선택: ")
(if (and (setq ss (ssget))
(setq p1 (getpoint "\n시작점: "))
(setq p2 (getpoint p1 "\n끝점: "))
(progn (initget 6) (setq n (getint "\n등분 개수: "))))
(if (> n 1)
(progn
(setq ang (angle p1 p2) step (/ (distance p1 p2) (float n)) k 1)
(repeat (1- n)
(command "_.COPY" ss "" "_non" p1 "_non" (polar p1 ang (* k step)))
(setq k (1+ k)))
(princ (strcat "\n" (itoa n) " 등분 간격으로 복사했습니다.")))
(princ "\n등분 개수는 2 이상입니다.")))
(vla-EndUndoMark doc)
(setvar "CMDECHO" ce)
(princ)
)
(princ "\n등분 자르기: EQ (등분·간격 자르기) / EQC (등분 복사) / torva.kr")
(princ)
;;; ---- 단축키 바꾸기 (TVKEY) - TORVA 리습 공통, torva.kr/lisp-guide.html ----
;;; TVKEY -> 명령 -> 새 단축키. 원래 명령어도 그대로 쓴다
;;; 정한 단축키는 이 PC 에 TORVA-KEYS 로 저장되고, 리습을 불러올 때마다 되살아난다
;;; (TORVA 리습 파일마다 같은 코드가 들어 있다. 여러 개를 불러와도 같은 정의를 덮어쓸 뿐이다)
;; "A1=PY;B2=CN;" -> (("A1" . "PY") ("B2" . "CN"))
(defun tv-key-list (/ s i out)
(setq s (cond ((getenv "TORVA-KEYS")) ("")) out nil)
(while (setq i (vl-string-search ";" s))
(setq out (cons (substr s 1 i) out) s (substr s (+ i 2))))
(if (/= s "") (setq out (cons s out)))
(vl-remove nil
(mapcar '(lambda (x / j) (if (setq j (vl-string-search "=" x)) (cons (substr x 1 j) (substr x (+ j 2)))))
(reverse out))))
(defun tv-key-save (lst)
(setenv "TORVA-KEYS" (apply 'strcat (mapcar '(lambda (p) (strcat (car p) "=" (cdr p) ";")) lst))))
;; 불러온 리습 명령인가
(defun tv-key-cmd-p (cmd)
(member (type (eval (read (strcat "C:" cmd)))) '(SUBR USUBR EXRXSUBR)))
(defun tv-key-def (key cmd)
(eval (list 'defun (read (strcat "C:" key)) '() (list (read (strcat "C:" cmd))) '(princ))))
;; acad.pgp 에 같은 별칭이 있나 ("L, *LINE")
(defun tv-key-pgp-p (key / f h l hit)
(if (setq f (findfile "acad.pgp"))
(progn
(setq h (open f "r"))
(while (and (not hit) (setq l (read-line h)))
(if (and (not (wcmatch l ";*")) (wcmatch (strcase l) (strcat key ",*"))) (setq hit T)))
(close h)))
hit)
;; 쓸 수 없는 단축키면 까닭을, 쓸 수 있으면 nil
(defun tv-key-bad (key lst)
(cond
((not (vl-every '(lambda (c) (or (<= 48 c 57) (<= 65 c 90))) (vl-string->list key))) "영문과 숫자만 씁니다")
((getcname key) "AutoCAD 명령과 같은 이름입니다")
((tv-key-pgp-p key) "AutoCAD 단축키(acad.pgp)와 같은 이름입니다")
((and (tv-key-cmd-p key) (not (assoc key lst))) "이미 있는 리습 명령입니다")))
(defun c:TVKEY (/ cmd key lst why)
(setq lst (tv-key-list)
cmd (strcase (getstring "\n단축키를 붙일 명령 [목록(?)]: ")))
(cond
((= cmd ""))
((= cmd "?")
(if lst
(foreach p lst (princ (strcat "\n " (car p) " = " (cdr p))))
(princ "\n정한 단축키가 없습니다")))
((not (tv-key-cmd-p cmd)) (princ (strcat "\n" cmd " 는 불러온 리습 명령이 아닙니다")))
(T
(setq key (strcase (getstring (strcat "\n" cmd " 의 새 단축키 [지우기(-)]: "))))
(cond
((= key ""))
((= key "-")
(foreach p lst
(if (= (cdr p) cmd) (set (read (strcat "C:" (car p))) nil)))
(tv-key-save (vl-remove-if '(lambda (p) (= (cdr p) cmd)) lst))
(princ (strcat "\n" cmd " 의 단축키를 지웠습니다")))
((= key cmd))
((setq why (tv-key-bad key lst)) (princ (strcat "\n" key ": " why)))
(T
(tv-key-save (cons (cons key cmd) (vl-remove-if '(lambda (p) (= (car p) key)) lst)))
(tv-key-def key cmd)
(princ (strcat "\n이제 " key " 로도 " cmd " 가 실행됩니다"))))))
(princ))
;; 불러올 때 - 저장된 단축키 중 명령이 불러와져 있는 것을 되살린다
(foreach p (tv-key-list)
(if (tv-key-cmd-p (cdr p)) (tv-key-def (car p) (cdr p))))
(princ "\n단축키 바꾸기: TVKEY")
(princ)