2014.03.07 10:55
여기에서 자동면적,길이를 구하는 tadd란 리습을 받아 실행하려는데 실행이 안되네요....도와주세요...
;| ;;
TotalADD Total Addition v. 1.0 ;;
By: Andrea Andreetti 2009-10-20 ;;
|;
;;
(princ
"\nTotalADDition v.1.0 activated! -run \"TADD\" to start or \"TADD-r\" to end."
)
(defun c:tadd (/ itemarea itemperimeter itemlinelength
itemarclength itemsplinelength itemregionperimeter itemcircumference
itemsplineperimeter itemplineperimeter itemplinelength itemtracelength
itemarclength itemellipselength a b c d p1 p2 itemlength tarea tperim tlength
)
(vl-load-com)
(defun *oo_object_modification* (objreactor objectsmodified)
(setq selected_objects (vla-get-pickfirstselectionset
(vla-get-activedocument (vlax-get-acad-object))
)
)
(setq itemarea 0
itemperimeter 0
itemlinelength 0
itemarclength 0
itemsplinelength 0
itemregionperimeter 0
itemcircumference 0
itemsplineperimeter 0
itemplineperimeter 0
itemplinelength 0
itemtracelength 0
itemarclength 0
itemellipselength 0
)
;AREA
(vlax-for n selected_objects
(if (vlax-property-available-p n 'area)
(if (eq (vla-get-objectname n) "AcDbRegion")
(setq itemarea (+ itemarea (vla-get-area n)))
(if (vlax-curve-isclosed n)
(setq itemarea (+ itemarea (vla-get-area n)))
)
)
)
;;CIRCLE
(if (vlax-property-available-p n 'circumference)
(setq itemcircumference (+ itemcircumference (vla-get-circumference n)))
)
;;SPLINE
(if (eq (vla-get-objectname n) "AcDbSpline")
(if (vlax-curve-isclosed n)
(setq itemsplineperimeter (+ itemsplineperimeter
(vlax-curve-getdistatparam n (vlax-curve-getendparam n))
)
)
(setq itemsplinelength (+ itemsplinelength
(vlax-curve-getdistatparam n (vlax-curve-getendparam n))
)
)
)
)
;;REGION
(if (eq (vla-get-objectname n) "AcDbRegion")
(setq itemregionperimeter (+ itemregionperimeter (vla-get-perimeter n)))
)
;;PLINE
(if (or (eq (vla-get-objectname n) "AcDb2dPolyline")
(eq (vla-get-objectname n) "AcDbPolyline")
)
(if (vlax-curve-isclosed n)
(setq itemplineperimeter (+ itemplineperimeter
(vlax-curve-getdistatparam n (vlax-curve-getendparam n))
)
)
(setq itemplinelength (+ itemplinelength
(vlax-curve-getdistatparam n (vlax-curve-getendparam n))
)
)
)
)
;;LINE
(if (eq (vla-get-objectname n) "AcDbLine")
(setq itemlinelength (+ itemlinelength (vla-get-length n)))
)
;;ARC
(if (eq (vla-get-objectname n) "AcDbArc")
(setq itemarclength (+ itemarclength (vla-get-arclength n)))
)
(if (eq (vla-get-objectname n) "AcDbEllipse")
(setq itemellipselength (+ itemellipselength
(vlax-curve-getdistatparam n (vlax-curve-getendparam n))
)
)
)
;;TRACE
(if (eq (vla-get-objectname n) "AcDbTrace")
(progn (setq plist (vlax-safearray->list
(vlax-variant-value (vla-get-coordinates n))
)
)
(setq a (list (nth 0 plist) (nth 1 plist) (nth 2 plist)))
(setq b (list (nth 3 plist) (nth 4 plist) (nth 5 plist)))
(setq c (list (nth 6 plist) (nth 7 plist) (nth 8 plist)))
(setq d (list (nth 9 plist) (nth 10 plist) (nth 11 plist)))
(setq p1 (polar a (angle a b) (/ (distance a b) 2.0)))
(setq p2 (polar c (angle c d) (/ (distance c d) 2.0)))
(setq itemtracelength (+ itemtracelength (distance p1 p2)))
)
)
)
;;_end vlax-for
(setq itemperimeter (+ itemcircumference
itemsplineperimeter
itemregionperimeter
itemplineperimeter
)
)
(setq itemlength (+ itemplinelength itemsplinelength itemlinelength itemtracelength itemarclength itemellipselength)
)
(setq tarea (rtos itemarea 2 8))
(setq tperim (rtos itemperimeter 2 8))
(setq tlength (rtos itemlength 2 8))
(acet-ui-status (strcat "Toatl Area: " tarea "\n" "Total Perimeter: " tperim "\n"
"Total Length: " tlength)
)
)
;;OBJECT SELECTION
(if oo_object_modification
(progn (vlr-remove oo_object_modification)
(setq oo_object_modification nil)
)
)
(setq oo_object_modification
(vlr-miscellaneous-reactor
nil
'((:vlr-pickfirstmodified . *oo_object_modification*))
)
)
;;Command ended
(if oo_object_modification_action
(progn (vlr-remove oo_object_modification_action)
(setq oo_object_modification_action nil)
)
)
(setq oo_object_modification_action
(vlr-command-reactor nil
'((:vlr-commandended . *oo_object_modification*)
;(:vlr-commandcancelled . *oo_object_modification_CANCEL*))
)
)
)
)
(defun c:TADD-r ()
(if oo_object_modification_action
(progn (vlr-remove oo_object_modification_action)
(setq oo_object_modification_action nil)
)
)
(if oo_object_modification
(progn (vlr-remove oo_object_modification)
(setq oo_object_modification nil)
)
)
)
번호 | 제목 | 글쓴이 | 날짜 | 조회 수 |
---|---|---|---|---|
공지 | ★ 드림플러스 질문은 메일 또는 홈페이지에 부탁합니다 ★ | 아저씨 | 2017.05.16 | 3502 |
공지 | 제목이 엉망이면 답변달지 않습니다. [1] | 아저씨 | 2014.04.04 | 24572 |
공지 | 순수 캐드 질문은 고캐드로 | 아저씨 | 2013.05.28 | 69486 |
공지 | 질문 답변 게시판을 만들었습니다. | 아저씨 | 2013.02.09 | 75647 |
517 | Cad상 작업시 오스냅이 안됩니다. [1] | 1231234 | 2014.03.14 | 968 |
516 | 드림실행시 오류?? [1] | masty | 2014.03.14 | 588 |
515 | 오토캐드 2008 드림 설치 후 매크로 찾을수 없음 [1] | 구르구르 | 2014.03.14 | 11805 |
514 | 질문드립니다! [1] | 캐드초보 | 2014.03.12 | 631 |
513 | 고수님 자동치수 가능한지 한번 봐주세요? ㅠㅠ: [1] | 붕붕 | 2014.03.11 | 704 |
512 | 은 이컴퓨터에서 더이상 유효하지 않으므로 개체를 불러올수 없습니다. [1] | 최정화 | 2014.03.10 | 3180 |
511 | 드림 명령어 사용후 마지막 셋팅값이 사라짐 [1] | 늘처음 | 2014.03.09 | 634 |
510 | 드림캐드를 깔고 싶은데요 (윈7 64비트, 캐드 2014 64비트입니다.) [1] | 아키폐인 | 2014.03.07 | 1653 |
» | 캐드 리습 실행시...VLR-Command-reactor 이라며 실행인 안되요.. [3] | 캐드소년 | 2014.03.07 | 1411 |
508 | 드림사용문의 [1] | dlfjdklg | 2014.03.06 | 673 |
507 | 혹시 드림 영어버전은 없나요? [1] | 123 | 2014.03.06 | 660 |
506 | 질문있습니다. [1] | 토쟁이 | 2014.03.05 | 552 |
505 | ㄴ [1] | 로어 | 2014.03.05 | 756 |
504 | 캐드가 잘 실행되다가...최대 세션수를 초과해서 열 수 없다고 나오는데... [1] | 예비군 | 2014.03.04 | 620 |
503 | 명령어 ADN 관련 문의드립니다. [1] | 하얀거리 | 2014.03.04 | 618 |
캐드 설치시 함께 설치하는 Express 설치되어 있어야되는 리습이네요
http://autoc.tistory.com/169 이 글 보시고 설치 안되어 있으면 설치 후 실행해보세요.
설치되었는데도 안되면
제가 아는 범위를 벗어난 것이니 고캐드 사이트의 질문방에 글 남겨보세요.