如何在Lisp中对多义线倒不同半径的园角?

shicai

陈伯雄

龙龙仔

shicai

龙龙仔

;;这个问题我并没有抓到重点,下例只供参考
;;FROM:前生
;;简单的说就是将一个pline线的所有圆角的R加上一个值
;;比如R1---->变成1.1后，将R到角变成C1.1的到C角。
;;用途是在机械设计上。
;;一个板上的孔是圆角，在孔里有一个一样大的镶块。
;;如果镶块在R角处变成大一点的C角的话，装配会方便很。

;|
前生兄:
思路:
1.先求出PLINE上所有圆角R值及R两端点坐标
2.再利用R两端点坐标倒C角 <C角=R值加上一个值>
PS:我已验证以上可行,但连续两个R角则不行!!
|;

(defun F_TO_C (ADD / HOLDOSMODE HOLDECHO HOLDBOX OBJ ENT LIST_RAD)
  ;;-----------------------------------------------------------
  ;; Function to return 2DPolyline data as a list in the format
  ;; (v1 bulge1 v2 bulge2 ... vn bulgen)
  ;; given one argument:
  ;;   Object = either an Ename or VLA-Object that is any of the
  ;;            following:
  ;;            AcDb2dPolyline ("Heavy" POLYLINE)
  ;;            AcDbPolyline   (LWPOLYLINE)
  ;;            AcDb2dVertex   ("Heavy" POLYLINE VERTEX)
  ;; Coordinates are in WCS, or OCS if object is nested.
  ;; NOTE that if the polyline is closed, the last vertex
  ;;      will equal the first vertex.
  ;; (c)2002, John F. Uhden, Cadlantic
  ;; Release 15.0 or higher
  ;; usage: (VLISTAX (CAR (ENTSEL)))

  (defun VLISTAX (OBJECT  /          NAME          PTYPE          ENDPARAM
                  PARAM          CLOSED  P1          P2          MIDP          BULGE
                  VLIST
                 )
    (vl-load-com)
    (setq OBJ OBJECT)
    (if        (not *ACAD*)
      (setq *ACAD* (vlax-get-acad-object))
    )
    (and
      (cond
        ((= (type OBJECT) 'VLA-OBJECT))
        ((= (type OBJECT) 'ENAME)
         (setq OBJECT (vlax-ename->vla-object OBJECT))
        )
        (t (setq OBJECT NIL))
      )
      (setq NAME (vla-get-objectname OBJECT))
      (cond
        ((= NAME "AcDb2dPolyline")
         (setq PTYPE (vla-get-type OBJECT))
        )
        ((= NAME "AcDbPolyline")
         (setq PTYPE 0)
        )
        ((= NAME "AcDb2dVertex")
         (setq OBJECT (vla-objectidtoobject
                        (vla-get-activedocument *ACAD*)
                        (vla-get-ownerid OBJECT)
                      )
               PTYPE  (vla-get-type OBJECT)
         )
        )
      )
      (setq CLOSED (vla-get-closed OBJECT))
      (setq ENDPARAM (vlax-curve-getendparam OBJECT))
      (setq PARAM ENDPARAM)
      (setq P2 (vlax-curve-getendpoint OBJECT))
      (setq VLIST (list P2))
      (while (> PARAM 0)
        (if (= PTYPE 0)                        ; acSimplePoly
          (setq        PARAM (1- PARAM)
                P1    (vlax-curve-getpointatparam OBJECT PARAM)
                BULGE (vla-getbulge OBJECT (fix PARAM))
          )
          (setq        PARAM (- PARAM 0.5)
                MIDP  (vlax-curve-getpointatparam OBJECT PARAM)
                PARAM (- PARAM 0.5)
                P1    (vlax-curve-getpointatparam OBJECT PARAM)
                BULGE (GETBULGE P1 MIDP P2)
          )
        )
        (setq VLIST (cons P1 (cons BULGE VLIST))
              P2    P1
        )
      )
    )
    (cond
      ((not VLIST) NIL)
      ((= CLOSED :vlax-true)
       (append VLIST (list (cadr VLIST)))
      )
      ((= PTYPE 0)
       (append VLIST (list (vla-getbulge OBJECT ENDPARAM)))
      )
      (t (append VLIST '(0.0)))
    )
  )

  ;; -- Function CalcBulge
  ;; Returns the geometric informations from a polyarc.
  ;; Copyright:
  ;;   c2001 MENZI ENGINEERING GmbH, Switzerland
  ;; Arguments [Typ]:
  ;;   Vx1 = Start vertex of p'arc [LIST]
  ;;   Vx2 = End vertex of p'arc [LIST]
  ;;   Blg = Bulge [REAL]
  ;; Return [Typ]:
  ;;   > '(CenterPoint Radius IncludedAngle) [LIST]
  ;; Notes:
  ;;   IncludedAngle in radians
  ;;
  ;;(calcbulge '(221.619 127.845 0.0)'(227.619 133.845 0.0) 0.414214))

  (defun CALCBULGE (VX1 VX2 BLG / ARCRAD HLFANG) ;CENDIR
    (setq HLFANG (* 2 (atan BLG))
          ;; CenDir ((if (< Blg 0) - +) (- (angle Vx1 Vx2) HlfAng) (/ pi 2))
          ARCRAD (abs (/ (/ (distance VX1 VX2) 2.0) (sin HLFANG)))
    )
    (list (list
            VX1
            VX2
            ;;(polar Vx1 CenDir ArcRad)
            ARCRAD
            ;;(* (abs HlfAng) 2.0)
          )
    )
  )

  (defun MAKE_LIST (PT_LIST / N LIST_INDEX)
    (setq N 1
          LIST_INDEX
           NIL
    )
    (repeat (/ (length PT_LIST) 2)
      (if (/= (nth N PT_LIST) 0)
        (setq LIST_INDEX
               (append LIST_INDEX
                       (list (list (nth (1- N) PT_LIST)
                                   (nth (1+ N) PT_LIST)
                                   (nth N PT_LIST)
                             )
                       )
               )
        )
      )
      (setq N (+ 2 N))
    )
    LIST_INDEX
  )

  (setq HOLDECHO (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (command "_.UNDO" "_GROUP")
  (setq HOLDOSMODE (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (foreach ENT (MAKE_LIST (VLISTAX (car (entsel))))
    (setq LIST_RAD (append LIST_RAD
                           (CALCBULGE (car ENT) (cadr ENT) (last ENT))
                   )
    )
  )
  (command "_.ZOOM" "E")
  (setvar "FILLETRAD" 0)
  (command "_.FILLET" "" OBJ)
  (setq HOLDBOX (getvar "ICKBOX"))
  (setvar "ICKBOX" 1)
  (foreach ENT LIST_RAD
    (command "_.CHAMFER" "D" (+ ADD (last ENT)) "")
    (command "_.CHAMFER" "NEA" (car ENT) "NEA" (cadr ENT))
  )
  (command "_.ZOOM" "")
  (setvar "OSMODE" HOLDOSMODE)
  (setvar "ICKBOX" HOLDBOX)
  (command "_.UNDO" "_END")
  (setvar "CMDECHO" HOLDECHO)
  (princ)
)

shicai