2012년 12월 25일 화요일

[LISP-GSJ] FuncGeometry.lsp (포스트아이디 : 3536210793345284536)


;;=========================================================================================================
;;=========================================================================================================
;;=========================================================================================================
(defun C:nFuncGeometry()
(princ "\nFuncGeometry")
(princ)
)
;;=========================================================================================================
;;=========================================================================================================
;; 두 객체의 교차점을 리턴(가상의 교차점)
;; ZWCAD에서 오류
;;=========================================================================================================
(defun Func_IntersectEntityExtend( dEntName01 dEntName02
 / dEntName01 dEntName02 dObjectName01 dObjectName02 dIntersectVariantPT
   dIntersectSafearray dSafearray dRtnList dListIntersect dCountNum)
(setq dObjectName01 (vlax-ename->vla-object dEntName01))
(setq dObjectName02 (vlax-ename->vla-object dEntName02))
;;-----------------------------------------------------------------------------------------------------
(setq dRtnList nil)
(setq dIntersectVariantPT (vla-intersectwith dObjectName01 dObjectName02 acExtendOtherEntity))
(if (= (substr (ver) 1 4) "LISP") ;; -> ZWCAD
(progn
(if (/= dIntersectVariantPT nil)
(progn
(setq dIntersectVariantPT (vlax-make-variant dIntersectVariantPT vlax-vbArray))
(setq dIntersectSafearray (vlax-variant-value dIntersectVariantPT))
)
(setq dRtnList nil)
)
)
(progn
(setq dIntersectSafearray (vlax-variant-value dIntersectVariantPT))
)
)
(if (/= dIntersectVariantPT nil)
(progn
;;---------------------------------------------------------------------------------------------
(setq dSafearray (vlax-safearray-get-u-bound dIntersectSafearray 1))
(if (> dSafearray 0)
(progn
(setq dListIntersect (vlax-safearray->list dIntersectSafearray))
(setq dCountNum 0)
(repeat (/ (length dListIntersect) 3)
(setq dIntersPT (list (nth dCountNum dListIntersect) (nth (+ dCountNum 1) dListIntersect) (nth (+ dCountNum 2) dListIntersect)))
(setq dRtnList (append dRtnList (list dIntersPT)))
(setq dCountNum (+ dCountNum 3))
)
)
)
)
)
dRtnList
)
;;=========================================================================================================
;;=========================================================================================================
;; 두객체의 교차점을 리턴(실제 교차점)
;;=========================================================================================================
(defun Func_IntersectEntityExtendNone( dEntName01 dEntName02
 / dEntName01 dEntName02 dObjectName01 dObjectName02 dIntersectVariantPT
dIntersectSafearray dSafearray dRtnList dListIntersect dCountNum)
(setq dObjectName01 (vlax-ename->vla-object dEntName01))
(setq dObjectName02 (vlax-ename->vla-object dEntName02))
;;------------------------------------------------------------------------------------------------------
(setq dRtnList nil)
(setq dIntersectVariantPT (vla-intersectwith dObjectName01 dObjectName02 acExtendNone))
(if (= (substr (ver) 1 4) "LISP") ;; -> ZWCAD
(progn
(if (/= dIntersectVariantPT nil)
(progn
(setq dIntersectVariantPT (vlax-make-variant dIntersectVariantPT vlax-vbArray))
(setq dIntersectSafearray (vlax-variant-value dIntersectVariantPT))
)
(setq dRtnList nil)
)
)
(progn
(setq dIntersectSafearray (vlax-variant-value dIntersectVariantPT))
)
)
(if (/= dIntersectVariantPT nil)
(progn
;;-------------------------------------------------------------------------------------------------
(setq dSafearray (vlax-safearray-get-u-bound dIntersectSafearray 1))
(if (> dSafearray 0)
(progn
(setq dListIntersect (vlax-safearray->list dIntersectSafearray))
(setq dCountNum 0)
(repeat (/ (length dListIntersect) 3)
(setq dIntersPT (list (nth dCountNum dListIntersect) (nth (+ dCountNum 1) dListIntersect) (nth (+ dCountNum 2) dListIntersect)))
(setq dRtnList (append dRtnList (list dIntersPT)))
(setq dCountNum (+ dCountNum 3))
)
)
)
)
)
dRtnList
)
;;=========================================================================================================
;;=========================================================================================================
;; 임의의 점이 도형의 내부, 외부 판정
;;=========================================================================================================
(defun Func_EntityInternal( dPT dEntityName
  / dPT dEntityName dPointList dAngleList dEP dAngle
    dInternalCheckEntity dIntersPoints dInternalCheck dExtentBox dMaxLength)
(setq dPointList (Func_EntityToPoint dEntityName))
(setq dExtentBox (Func_GetExtent dPointList))
(setq dMaxLength (distance (car dExtentBox) (cadr dExtentBox)))
(setq dAngleList (list ))
(foreach dEP (cdr dPointList)
(setq dAngleList (append dAngleList (list (angle dPT dEP))))
)
(setq dAngleList (vl-sort dAngleList '>))
(setq dAngleList (Func_RemoveItem dAngleList))
(setq dAngle (/ (+ (car dAngleList) (cadr dAngleList)) 2.0))
(setq dInternalCheckEntity (Func_MakeEntity "LINE" "0" "ByLayer" 1 (list dPT (polar dPT dAngle dMaxLength)) 0))
(setq dIntersPoints (Func_IntersectEntityExtendNone dEntityName dInternalCheckEntity))
(entdel dInternalCheckEntity)
(if (= (rem (length dIntersPoints) 2) 1)
(setq dInternalCheck 'T)
(setq dInternalCheck nil)
)
dInternalCheck
)
;;=====================================================================================================
;;=====================================================================================================
;; ZWCAD에서 BPOLY 함수가 지원 안됨
;;=====================================================================================================
(defun Func_ZWBPoly(dPT / *error* dPT dCMDEcho dEntLast dEntPoly)
;;-----------------------------------------------------------------------------------------------------
(defun *error*(msg)
;(if (not (member msg '("console break" "Function cancelled")))
; (princ (strcat "\nError: " msg));Print error
;)
(setvar "cmdecho"   dCMDEcho)
(princ "\n; 오류: 함수가 취소되었습니다.")
)
;;-----------------------------------------------------------------------------------------------------
(setq dCMDEcho (getvar "cmdecho"))
(setvar "cmdecho" 0)
;;-----------------------------------------------------------------------------------------------------
(setq dEntLast (entlast))
;;-----------------------------------------------------------------------------------------------------
(command "BOUNDARY" dPT "")
(setq dEntPoly (entlast))
;;-----------------------------------------------------------------------------------------------------
(setvar "cmdecho" dCMDEcho)
;;-----------------------------------------------------------------------------------------------------
(if (equal dEntLast dEntPoly)
(setq dEntPoly nil)
)
dEntPoly
)
;;=====================================================================================================
;;=====================================================================================================
;; 두개의 좌표를 전달 받아 중간점 좌표를 반환
;;=====================================================================================================
(defun Func_MidPoint( ptFirst ptSecond / ptFirst ptSecond Ang Dist ptMidPoint)
   (setq Ang (Angle ptFirst ptSecond))
   (setq Dist (distance ptFirst ptSecond))
   (setq ptMidPoint (polar ptFirst Ang (/ Dist 2.0)))
   ptMidPoint
)
;;=========================================================================================================
;;=========================================================================================================
;; LWPolyLine 객체를 전달받아 면적을 리턴
;;=========================================================================================================
(defun Func_EntityAreaCommand(dEntityName / dEntityName)
(command "AREA" "O" dEntityName)
(getvar "AREA")
)
;;=========================================================================================================
;;=========================================================================================================
;; LWPolyLine 객체를 전달받아 면적을 리턴
;;=========================================================================================================
(defun Func_EntityArea(dEntityName / dEntityName dObjName dModelSpace dSafeArray dRegionObj dArea)
(setq dOjectName (vlax-ename->vla-object dEntityName))
(setq dModelSpace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(setq dSafeArray  (vlax-make-safearray vlax-vbObject '(0 . 0)))
(vlax-safearray-put-element dSafeArray 0 dOjectName)
(setq dRegionObj (car (vlax-safearray->list (vlax-variant-value (vla-addregion dModelSpace dSafeArray)))))
(setq dArea (vla-get-area dRegionObj))
(vla-delete dRegionObj)
dArea
)
;;=========================================================================================================
;;=========================================================================================================
;; LWPolyLine 객체를 전달받아 다각형의 중심점을 리턴한다.
;;=========================================================================================================
(defun Func_EntityGravity(dEntityName / dEntityName dOjectName dModelSpace dSafeArray dRegionObj dCenterPT)
   (setq dOjectName (vlax-ename->vla-object dEntityName))
   (setq dModelSpace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
   (setq dSafeArray (vlax-make-safearray vlax-vbObject '(0 . 0)))
   (vlax-safearray-put-element dSafeArray 0 dOjectName)
   (setq dRegionObj (car (vlax-safearray->list (vlax-variant-value (vla-addregion dModelSpace dSafeArray)))))
   (setq dCenterPT (vla-get-centroid dRegionObj))
   (vla-delete dRegionObj)
   (vlax-safearray->list (vlax-variant-value dCenterPT))
)
;;=========================================================================================================
;;=========================================================================================================
;; ARC의 PT01, PT02, Bulgs값을 전달받아 (list 중심점 반지름 호길이)를 리턴한다.
;; (Func_BulgeToARC lPT01 lPT02 lBulgValue)
;;=========================================================================================================
(defun Func_BulgeToARC( dPT1 dPT02 dArcBulg
  / dPT1 dPT02 dArcBulg dDelta dDistance dAngle dRadius dCenterPT dArcLength)
(setq dDelta (* (atan dArcBulg) 4.0))
(setq dAngle (angle dPT1 dPT02))
(setq dDistance (distance dPT1 dPT02))
(setq dRadius (/ dDistance (sin (/ dDelta 2.0)) 2.0))
(setq dCenterPT (polar dPT1 (+ dAngle (/ (- pi dDelta) 2.0)) dRadius))
(setq dRadius (abs dRadius))
(setq dArcLength (abs (* dDelta dRadius)))
(list dCenterPT dRadius dArcLength)
)
;;=========================================================================================================
;;=========================================================================================================
;;=========================================================================================================
(princ)

댓글 없음:

댓글 쓰기

즐거운 하루되세요...^^