Re:양쪽 모따기 말구... 한쪽모따기만 할수 없을까요??

[달수]

;;;¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø? ?º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º? ?`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,;;;

;;; 한쪽만 Chamfer (Create by 아키모아 달수 2011.01.11)

;;;ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤? ?,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸ ¸,ø¤º°`°º¤ø,¸¸,¤º°`°º¤;;;

(defun c:LCH (/ AcObj AcDoc mSpace cfDist pt1 cfDistTmp pt3 ss obj1 obj2 ptInt ptobj1 ptobj2 ang)

    (vl-load-com)

    (setq AcObj (vlax-get-acad-object))

    (setq AcDoc (vla-get-ActiveDocument AcObj))

    (setq mSpace (vla-get-modelspace AcDoc))

    (defun *ERROR* (st)(princ "\n error: ")(MrEND)(princ))

    (defun MrSTA ()

        (setq gvar '("OSMODE" "CMDECHO"))

        (setq gvar_val (mapcar 'getvar gvar))

        (mapcar 'setvar gvar '(0 0))

        (vla-startundomark AcDoc)

    )

    (defun MrEND ()

        (mapcar 'setvar gvar gvar_val)

        (vla-endundomark AcDoc)

    )

    (defun sub3dInterPointList (obj1 obj2 ind / foo)

        (defun foo (lst) (if lst (cons (list (car lst)(cadr lst)(caddr lst))(foo (cdddr lst)))))

        (foo (vlax-invoke obj1 'intersectwith obj2 ind))

    )

    (defun subChamferLine (obj1 obj2 ptobj1 ptobj2 StaEnd / lay col lty newPt obj acadVer cObj)

        (setq lay (vla-get-layer obj2))

        (setq col (vla-get-ColorIndex (vla-get-TrueColor obj2)))

        (setq lty (vla-get-Linetype obj2))

        (setq newPt (polar ptInt ang cfDist))

        (if (= StaEnd "end")

            (vla-put-EndPoint obj2 (vlax-3d-point newPt))

            (vla-put-StartPoint obj2 (vlax-3d-point newPt))

        )

        (setq obj

            (vla-addline mSpace

                (vlax-3d-point newPt)

                (vlax-3d-point (polar ptInt (angle ptInt ptobj1) cfDist))

            )

        )

        (vla-put-layer obj lay)

        (setq acadVer (strcat "AutoCAD.AcCmColor." (itoa (atoi (getvar "acadver")))))

        (setq cObj (vla-getinterfaceobject (vlax-get-acad-object) acadVer))

        (vla-put-ColorIndex cObj col)

        (vla-put-TrueColor obj cObj)

        (vla-put-Linetype obj lty)

    )

    (MrSTA)

    (setq cfDist (getvar "CHAMFERA"))

    (initget 128)

    (while

        (or

            (=  (type

                    (setq pt1

                        (getpoint

                            (strcat "\n[ Change<Enter> chamfer distance : " (rtos cfDist 2 4) " ] 첫번째 지점: ")

                        )

                    )

                )

                'STR

            )

            (null pt1)

        )

        (setq cfDistTmp (getreal (strcat "\nEnter chamfer distance<" (rtos cfDist 2 4) ">: ")))

        (if cfDistTmp

            (progn

                (setq cfDist cfDistTmp)

                (setvar "CHAMFERA" cfDist)

            )

        )

        (initget 128)

    )

    (if (and

            pt1

            (setq pt3 (getcorner pt1 "\n반대편 지점: "))

            (setq ss (ssget "C" pt1 pt3 '((0 . "LINE"))))

            (= (sslength ss) 2)

            (setq obj1 (vlax-ename->vla-object (ssname ss 0)))

            (setq obj2 (vlax-ename->vla-object (ssname ss 1)))

            (setq ptInt (car (sub3dInterPointList obj1 obj2 3)))

            (setq ptobj1 (vlax-Curve-GetClosestPointTo obj1 pt1))

            (setq ptobj2 (vlax-Curve-GetClosestPointTo obj2 pt1))

        )

        (progn

            (if (< (distance pt1 ptobj1)(distance pt1 ptobj2))

                (if (=

                        (angle ptInt (vlax-Curve-GetStartPoint obj2))

                        (setq ang (angle ptInt ptobj2))

                    )

                    (subChamferLine obj1 obj2 ptobj1 ptobj2 "end")

                    (subChamferLine obj1 obj2 ptobj1 ptobj2 "sta")

                )

                (if (=

                        (angle ptInt (vlax-Curve-GetStartPoint obj1))

                        (setq ang (angle ptInt ptobj1))

                    )

                    (subChamferLine obj2 obj1 ptobj2 ptobj1 "end")

                    (subChamferLine obj2 obj1 ptobj2 ptobj1 "sta")

                )

            )

        )

    )

    (MrEND)(princ)

)

(princ "[명령어 : LCH ]")(princ)

 

이 리습은 사용규칙을 알아야만 사용할 수 있습니다.

조건 : 두개의 라인일 경우만 실행됨

1) 첫번째지점을 찍을때 Chamfer의 값을 변경하고 싶으면 엔터하세요..

2) 첫번째 지점을 찍었을때..첫번째 지점과 두선과의 간격이 가까운 선은 고정이 되고

    첫번째 지점의 반대편쪽이 잘립니다. 경우의 수가 8가지가 나오겠져? 아래 그림을 참조해서 보세요..

 

  LCH(한쪽모따기).lsp

[『형진`s』]

달수님 수고하셧습니다.^^

[3:16]

아..달수님 수고하셨습니당^^* 멋지세요^^*

[아부라카다부라]

후아..좋네요..^^감사합니다...

[행복한하루]

수고하셨습니다.^^

[올빼미]

수고하셨습니당....

[하늘_별]

와우...달수님...수고 하셨습니다...ㅎㅎ

[돌파구]

달수님. 수고 하셨습니다.^^

[디오니소스]

달수님 존경 합니다.^^* 수고 하셨습니다.
LCH 잘 모시고 갑니다. ^^*
달수님 혹시 LCF는 없나요?^^*

[달수]

위 소스에서 살짝 수정만 해주면 되는건데요..ㅎㅎ

[디오니소스]

많이는 아니고 살짝~ 이군요.ㅎㅎㅎ 살짝 수정 해보도록 하겠습니다.ㅋㅋ
만들고 싶은 기능은 너무 많은데 실력도 부족한데다 시간까지 없네요.
구상중인 프로그램만 노트 한권이라는....... ㅎㅎㅎㅎㅎ