[原创]：一个求多义线各段参数的lisp程序

highflybird

我们知道，如果一条多义线中包含弧段时候，这时候CAD只是告诉你圆心和凸度，而不知道半径，弧长，下面我编写了一个lisp程序，能列出这些参数。
[php]
;;;******************************************************
;;;一个求多义线各段参数(如果是弧段则有半径弧长)的lisp程序
;;;编号  1:凸度，2:弦长或直段长，3:半径，4:弧长，5:圆心--
;;;加载程序，运行bulge，则显示上述参数-------------------
(defun C:Bulge (/ ss1 ename el obj len ifclose i par ptfirst ptend judge
                tu pt1 pt2 dis radius h h1 half-angle arc-length pa cen)
  (setq ss1 (ssget ":S" '((-4 . "<OR")
                        (0 . "POLYLINE")
                        (0 . "LWPOLYLINE")
                        (-4 . "OR>")))
  )
  (if (or nil (= ss1 nil) (/= (assoc 75 (entget (ssname ss1 0))) nil))
    (progn
      (alert "你没有选中物体或者选择的不是多义线!")
      (princ)
    )
    (progn
      (setq ename (ssname ss1 0))
      (setq el (entget ename))
      (setq obj (vlax-ename->vla-object ename))
      (setq len (cdr (assoc 90 el)))
      (setq ifclose (cdr (assoc 70 el)))
      (setq i 0 par nil)
      (setq ptfirst (vlax-curve-getpointatparam ename 0))
      (setq ptend (vlax-curve-getpointatparam ename (1- len)))
      (setq judge (and (not (equal ptfirst ptend 1e-8)) (= ifclose 1)))
      (repeat (if judge len (1- len))
        (setq tu (vla-getBulge obj i))
        (setq pt1 (vlax-curve-getpointatparam ename i))
        (if (and (= i (1- len)) judge)
          (setq pt2 (vlax-curve-getpointatparam ename 0))
          (setq pt2 (vlax-curve-getpointatparam ename (1+ i)))  
        )
        (setq dis (distance pt1 pt2))
        (if (/= tu 0)
          (progn   
            (setq radius (/ (* (+ 1.0 (* tu tu)) dis 0.25) (abs tu)))
            (setq h (* dis (abs tu) 0.5) h1 (- radius h))
            (setq half-angle (atan (/ dis 2) h1))
            (setq arc-length (* 2 half-angle radius))
            (setq cen (midp pt1 pt2))
            (setq cen (polar cen
                             (+ (angle pt1 pt2)
                                (if (or nil (and (> h1 0) (> tu 0)) (and (< h1 0) (< tu 0)))
                                  (* pi 0.5) (* pi -0.5)
                                )
                             )                             
                             (abs h1)
                      )
            )
            (setq pa (list tu dis radius arc-length cen))
            (setq par (cons pa par))
          )
          (progn
            (setq pa (list tu dis))
            (setq par (cons pa par))
          )
        )
        (setq i (1+ i))
      )
      (setq par (reverse par))
      (princ "\n下面为此曲线的各段列表,3,4,5编号为弧段才有:")
      (princ "\n1:凸度 2:弦长(或直线长) 3:半径 4:弧长 5:圆心")
      (foreach n par
        (princ "\n")
        (princ n)
      )
      (princ)
    )
  )
)
;;;******************************************************
[/php]

kohi

[php]
(defun c:segmentdetail ()
  (setq ent (entsel "Pick a polyline: "))
  (setq obj (vlax-ename->vla-object (car ent)))
  (setq pt (cadr ent))
  (setq cpt (vlax-curve-getClosestPointTo obj pt T))
  (setq n (fix (vlax-curve-getParamAtPoint obj cpt)))
  (setq bul (vla-getBulge obj n))
  (vla-getwidth obj n 'w1 'w2)
  (list n (vlax-curve-getPointAtParam obj n)
          (vlax-curve-getPointAtParam obj (1+ n)) w1 w2 bul)
)
[/php]