오토캐드 리습인데 캐디안에서 실행될수 있게 수정좀 부탁드립니다,
컨텐츠 정보
- 398 조회
- 1 댓글
- 0 추천
- 0 비추천
- 목록
본문
오토캐드리습인데 캐디안 클래식에서 실행되게 수정좀 부탁드립니다,
(defun c:a (/ circle text @line @pline ename->obj tlst xx @dist aa aaa ss a llist)
(defun Circle (cen rad)
(entmakex (list (cons 0 "CIRCLE")
(cons 10 cen)
(cons 40 rad))))
(defun Text (pt hgt str ang)
(entmakex (list (cons 0 "TEXT")
(cons 10 '(0 0))
(cons 11 pt)
(cons 40 hgt)
(cons 50 ang)
(cons 72 1)
(cons 73 2)
(cons 1 str))))
(defun ename->obj (l) (mapcar 'vlax-ename->vla-object l))
(defun tlst (l) (if l (cons (list (car l) (cadr l) 0) (tlst (cddr l)))))
(defun xx (l) (if l (cons (car l) (xx (vl-remove (car l) (cdr l))))))
(defun @dist (l)
(if (cadr l) (cons (list (distance (car l) (cadr l)) (angle (car l) (cadr l))) (@dist (cdr l))))
)
(defun aaa (l) (if l (cons (list (car l) (- (length l) (length (vl-remove (car l) l)))) (aaa (vl-remove (car l) l)))))
(defun aa (l) (if l (if (= (cadr l) 1) (strcat (rtos (car l) 2 2) "+") (strcat (rtos (car l) 2 2) "*" (rtos (cadr l) 2 2) "+"))))
(defun bb (l) (if l (strcat (vl-princ-to-string (car l)) "+")))
(defun @line (l / spt ept dist ang pt sc i pt1 tot tt)
(setq i 0
p1 (getpoint "n문자 선택 점:")
tot nil)
(mapcar
'(lambda(x)
(setq spt (vlax-get x 'StartPoint)
ept (vlax-get x 'EndPoint)
dist (/ (distance spt ept) 1000)
ang (angle spt ept)
pt (list (/ (+ (car spt) (car ept)) 2) (/ (+ (cadr spt) (cadr ept)) 2) 0)
sc (getvar 'dimscale))
(text pt (* sc 2.5) (vl-princ-to-string dist) ang) ;<- 2.5 문자크기
(circle (setq pt1 (polar pt (- ang (/ pi 2)) (* sc 4))) (* sc 1.5))
(text pt1 (* sc 1.0) (vl-princ-to-string (setq i (+ i 1))) 0) ;<- 1.0 문자크기
(setq tot (append tot (list dist)))
)
l)
(setq tt (apply 'strcat (mapcar '(lambda(x) (strcat (rtos x 2 2) "+")) tot)))
(text p1 (* sc 2.5) (strcat (substr tt 1 (- (strlen tt) 1)) "=" (rtos (apply '+ tot) 2 2)) 0) ;<- 2.5 문자크기
)
(defun @pline (l / cdn dis dist1 total i p1 pt sc z tt)
(setq cdn (xx (tlst (vlax-get l 'Coordinates))))
(if (= (vlax-get l 'Closed) -1)
(setq dis (@dist (append cdn (list (car cdn)))))
(setq dis (@dist cdn)))
(setq dist1 (mapcar '(lambda(x) (/ x 1000)) (mapcar 'car dis))
total (rtos (apply '+ dist1) 2 2)
i 0
p1 (getpoint "n문자 선택 점:"))
(mapcar
'(lambda(x y)
(setq pt (polar y (cadr x) (/ (car x) 2))
sc (getvar 'dimscale))
(text pt (* sc 2.5) (rtos (* (car x) 0.001) 2 2) (cadr x)) ;<- 2.5 문자크기
(circle (setq pt1 (polar pt (- (cadr x) (/ pi 2)) (* sc 4))) (* sc 1.5))
(text pt1 (* sc 1.0) (vl-princ-to-string(setq i (+ i 1))) 0) ;<- 1.0 문자크기
)
dis cdn)
(setq z (aaa dist1)
tt (apply 'strcat (mapcar 'aa z)))
(text p1 (* sc 2.5) (strcat (substr tt 1 (- (strlen tt) 1)) "=" total) 0) ;<- 2.5 문자크기
)
(setq ss (ssget '((0 . "*line")))
a (ename->obj (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
(mapcar
'(lambda(x)
(setq objname (vla-get-ObjectName x))
(if (= objname "AcDbPolyline") (@pline x)
)
(if (= objname "AcDbLine") (setq llist (append (list x) llist)))
)
a
)
(if llist (@line llist))
(princ)
)