[LISP函数]：怎么获得多义线某分段的长度

fengjianwei · 发表于 2006-10-22 19:31:48

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

如题，你点击多义线，则显示该分段的长度

雨箭风刀 · 发表于 2006-10-26 12:40:56

求cen也可以用(osnap pt "cen")

oyxx_1023 · 发表于 2006-10-22 20:01:47

(defun c:test ()
(setq ent (entsel "\nselect pline:"))
(setq obj (vlax-ename->vla-object (car ent)))
(setq pt (cadr ent))
(setq param (vlax-curve-getparamatpoint
obj
(vlax-curve-getclosestpointto obj pt)
)
)
(setq pre-pt-index (fix param))
(setq next-pt-index (+ (fix param) 1))
(setq
pre-pt (vlax-safearray->list
(vlax-variant-value
(vla-get-coordinate obj pre-pt-index)
)
)
)
(setq
next-pt (vlax-safearray->list
(vlax-variant-value
(vla-get-coordinate obj next-pt-index)
)
)
)
(princ (strcat "\n本段长:" (rtos (distance pre-pt next-pt)))
)
(princ)
)

fengjianwei · 发表于 2006-10-22 20:04:16

偶试试看高手啊回复这么快

fsxm · 发表于 2006-10-22 22:52:54

两个vlax-curve-getDistAtParam之差
要比(distance pre-pt next-pt)更简明
也更准确~比如有弧段的多义线~

dwg001 · 发表于 2006-10-23 09:06:19

bug--->多义线中含有弧线时，结果误。显示的是两顶点的距离，而不是弧线长度。

llmin · 发表于 2006-10-23 09:41:04

最初由 dwg001 发布
[B]bug--->多义线中含有弧线时，结果误。显示的是两顶点的距离，而不是弧线长度。 [/B]

简单实用，很不错，我顶一下。

舟自横 · 发表于 2006-10-23 10:36:42

獲取復線某子段信息，長度可以根據信息計算(比較通用)

(defun hy_pickcoordSEG(ename pt / obj PP PA n1 n2 p1 p2 dis mp bulge gongao
rad centerp golist);;;獲取點擊子段的信息
(setq obj (vlax-ename->vla-object ename)
pp (vlax-curve-getclosestpointto obj (trans pT 1 0))
pa (vlax-curve-getparamatpoint obj pp))
(setq n1 (fix pa) n2 (fix (+ 1 pa)))
;;(if (> n2 (length (massoc 10 (entget ename)))) (setq n2 0))
(setq p1 (vlax-curve-getpointatparam obj n1)
p2 (vlax-curve-getpointatparam obj n2)
)
(setq dis (distance p1 p2))
(SETQ MP (MAPCAR '(LAMBDA (x y) (/ (+ x y) 2)) p1 p2))
(if (/= 0 (setq bulge (vla-getbulge obj n1)));;凸度=弓高/(* 0.5 弦長)
(progn
(setq gongao (abs (* (/ dis 2) bulge)));;弓高
(setq rad (/ (+ (expt gongao 2) (expt (/ dis 2) 2)) (* 2 gongao )));GET THE RADIUS
(cond ((> 0 bulge);;;;;;;;;;;;;;;;;;;;;;;;;(and (= 1 (hy_osorns ename)) (> 0 bulge))
(setq centerp (polar mp (- (angle p1 p2) (* 0.5 pi)) (- rad gongao))
golist (list (cons 0 "ARC")
(CONS "STP" (LIST p2))
(CONS "ENP" (LIST p1))
(CONS "CEN" (list centerp))))
)
((< 0 bulge);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(and (= 1 (hy_osorns ename)) (< 0 bulge))
(setq centerp (polar mp (+ (angle p1 p2) (* 0.5 pi)) (- rad gongao))
golist (list (cons 0 "ARC")
(CONS "STP" (LIST p1))
(CONS "ENP" (LIST p2))
(CONS "CEN" (list centerp))))
)
)
)
(setq golist (list (cons 0 "LINE")
(CONS "LEN" dis)
(CONS "STP" (list p1))
(CONS "ENP" (list p2))))
)
GOLIST
)

(defun hy_pickcoordSEG(ename pt / obj PP PA n1 n2 p1 p2 dis mp bulge gongao 
                       rad centerp golist);;;獲取點擊子段的信息 
  (setq obj (vlax-ename->vla-object ename) 
         pp (vlax-curve-getclosestpointto obj (trans pT 1 0)) 
          pa (vlax-curve-getparamatpoint obj pp)) 
  (setq n1 (fix pa) n2 (fix (+ 1 pa))) 
  ;;(if (> n2 (length (massoc 10 (entget ename)))) (setq n2 0)) 
  (setq p1 (vlax-curve-getpointatparam obj n1) 
        p2 (vlax-curve-getpointatparam obj n2) 
        ) 
  (setq dis (distance p1 p2)) 
  (SETQ MP (MAPCAR '(LAMBDA (x y) (/ (+ x y) 2)) p1 p2)) 
  (if (/= 0 (setq bulge (vla-getbulge obj n1)));;凸度=弓高/(* 0.5 弦長) 
    (progn 
      (setq gongao (abs (* (/ dis 2) bulge)));;弓高 
      (setq rad (/ (+ (expt gongao 2) (expt (/ dis 2) 2)) (* 2 gongao )));GET THE RADIUS 
      (cond ((> 0 bulge);;;;;;;;;;;;;;;;;;;;;;;;;(and (= 1 (hy_osorns ename)) (> 0 bulge)) 
                  (setq centerp (polar mp (- (angle p1 p2) (* 0.5 pi)) (- rad gongao)) 
                        golist (list (cons 0 "ARC") 
                                     (CONS "STP" (LIST p2)) 
                                     (CONS "ENP" (LIST p1)) 
                                     (CONS "CEN" (list centerp)))) 
             ) 
            ((< 0 bulge);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(and (= 1 (hy_osorns ename)) (< 0 bulge)) 
                 (setq centerp (polar mp (+ (angle p1 p2) (* 0.5 pi)) (- rad gongao)) 
                       golist (list (cons 0 "ARC") 
                                     (CONS "STP" (LIST p1)) 
                                     (CONS "ENP" (LIST p2)) 
                                     (CONS "CEN" (list centerp)))) 
           ) 
            ) 
    ) 
    (setq golist (list (cons 0 "LINE") 
                       (CONS "LEN" dis) 
                       (CONS "STP" (list p1)) 
                       (CONS "ENP" (list p2)))) 
              
  ) 
  GOLIST 
  )

;;;例如返回
;;((0 . "ARC") ("STP" (14.7963 9.04745 0.0)) ("ENP" (10.6489 9.02818 0.0)) ("CEN" (12.7237 8.81554 0.0)))
;;((0 . "LINE") ("LEN" . 2.24709) ("STP" (3.9658 10.5263 0.0)) ("ENP" (5.95223 11.5768 0.0)))

dwg001 · 发表于 2006-10-23 13:11:59

舟自横兄的ok.
加一段调用：
(defun c:gti(/ ss ename  pt)
(setq ss (entsel "\n选择物体...\n"))
(setq ename (car ss)
   pt (cadr ss)
)
(hy_pickcoordSEG  ename pt)
)

;如将返回的表列东西提取出来，更符合题意。

eachy · 发表于 2006-10-23 15:24:54

多看看 vlax-curve 部分

(defun subSEG (ent pt / pam pam1 p1 p2 dis dis1 pv)
(setq pt (vlax-curve-getclosestpointto ent pt)
pam (fix (vlax-curve-getparamatpoint ent pt))
pam1 (1+ pam)
dis (- (vlax-curve-getdistatparam ent pam1)
(vlax-curve-getdistatparam ent pam)
)
p1 (vlax-curve-getpointatparam ent pam)
p2 (vlax-curve-getpointatparam ent pam1)
dis1 (distance p1 p2)
)
(if (equal dis1 dis)
(list '(0 . "LINE")
(cons "LEN" dis)
(cons "STP" p1)
(cons "ENP" p2)
)
(list
'(0 . "ARC")
(cons "LEN" dis)
(cons "STP" p1)
(cons "ENP" p2)
(cons
"CEN"
(polar pt
(angle (setq pv (vlax-curve-getsecondderiv
ent
(vlax-curve-getparamatpoint ent pt)
)
)
'(0. 0.)
)
(distance pv '(0. 0.))
)
)
)
)
)

(defun subSEG (ent pt / pam pam1 p1 p2 dis dis1 pv) 
  (setq        pt   (vlax-curve-getclosestpointto ent pt) 
        pam  (fix (vlax-curve-getparamatpoint ent pt)) 
        pam1 (1+ pam) 
        dis  (-        (vlax-curve-getdistatparam ent pam1) 
                (vlax-curve-getdistatparam ent pam) 
             ) 
        p1   (vlax-curve-getpointatparam ent pam) 
        p2   (vlax-curve-getpointatparam ent pam1) 
        dis1 (distance p1 p2) 
  ) 
  (if (equal dis1 dis) 
    (list '(0 . "LINE") 
          (cons "LEN" dis) 
          (cons "STP" p1) 
          (cons "ENP" p2) 
    ) 
    (list 
      '(0 . "ARC") 
      (cons "LEN" dis) 
      (cons "STP" p1) 
      (cons "ENP" p2) 
      (cons 
        "CEN" 
        (polar pt 
               (angle (setq pv (vlax-curve-getsecondderiv 
                                 ent 
                                 (vlax-curve-getparamatpoint ent pt) 
                               ) 
                      ) 
                      '(0. 0.) 
               ) 
               (distance pv '(0. 0.)) 
        ) 
      ) 
    ) 
  ) 
)

雨箭风刀 · 发表于 2006-10-23 23:04:31

;; 主要是变了一下cen的计算方法.

(defun subSEG2 (ent pt / CEN DIS END LEN P1 P2 PAM1 PAM2 PRN)
(setq pt (vlax-curve-getclosestpointto ent pt)
pam1 (fix (vlax-curve-getparamatpoint ent pt))
pam2 (1+ pam1)
p1 (vlax-curve-getpointatparam ent pam1)
p2 (vlax-curve-getpointatparam ent pam2)
len (-(vlax-curve-getdistatparam ent pam2)(vlax-curve-getdistatparam ent pam1))
dis (distance p1 p2)
cen (mapcar '- pt (vlax-curve-getsecondderiv ent(vlax-curve-getparamatpoint ent pt)))
end (if (equal dis len) (list len p1 p2)(list len p1 p2 cen))
PRN (mapcar 'cons '("LEN" "STA" "END" "CEN") end)
prn (IF (=(LENGTH PRN) 3)(cons '(("LINE")) prn)(cons '("ARC") prn))
)
)
(DEFUN C:TTT ()(MAPCAR 'PRINT (APPLY 'SUBSEG2 (ENTSEL)))(PRINC))

fsxm · 发表于 2006-10-24 21:32:04

两位老大的算法都是存在bug有~比如一顺时针与一反时针pl线secondderiv 向量是相反的样的~

舟自横 · 发表于 2006-10-25 12:03:41

yes! 我正是考慮這一點所以要加判斷bugle正負的情況

xyp1964 · 发表于 2006-10-26 00:09:51

[FONT=courier new](defun c:test211 ()
(CMDLASC0)
(setq ss (ssget '((0 . "*LINE")))
ttx ""
l 0
i -1
)
(xyp-mkLaCo "线长标注" 4)
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq ptlst-a (xyp-get-Vertexes s1 t))
(while (setq pt1 (car ptlst-a))
(if (setq ptlst-a (cdr ptlst-a))
(progn
(setq pt2 (car ptlst-a)
leng (distance pt1 pt2)
tx (rtos leng 2 2)
ang (xyp-rad2Ang (angle pt1 pt2))
pt-tx (xyp-get-RightPoint pt1 pt2 (* sc 100))
ttx (strcat ttx "+" tx)
l (+ l leng)
)
(command "text" "j" "BC" pt-tx (* sc 300) ang tx)
)
)
)
)
(if (and ttx l)
(progn
(setq ttx (strcat ttx "=" (rtos l 2 2)))
(while (not (setq pt (getpoint "\n计算式标注点 : "))))
(command "text" "j" "BC" pt (* sc 300) 0 ttx)
)
)
(CMDLA1)
)[/FONT]

[FONT=courier new](defun c:test211 () 
  (CMDLASC0) 
  (setq        ss  (ssget '((0 . "*LINE"))) 
        ttx "" 
        l   0 
        i   -1 
  ) 
  (xyp-mkLaCo "线长标注" 4) 
  (while (setq s1 (ssname ss (setq i (1+ i)))) 
    (setq ptlst-a (xyp-get-Vertexes s1 t)) 
    (while (setq pt1 (car ptlst-a)) 
      (if (setq ptlst-a (cdr ptlst-a)) 
        (progn 
          (setq        pt2   (car ptlst-a) 
                leng  (distance pt1 pt2) 
                tx    (rtos leng 2 2) 
                ang   (xyp-rad2Ang (angle pt1 pt2)) 
                pt-tx (xyp-get-RightPoint pt1 pt2 (* sc 100)) 
                ttx   (strcat ttx "+" tx) 
                l     (+ l leng) 
          ) 
          (command "text" "j" "BC" pt-tx (* sc 300) ang tx) 
        ) 
      ) 
    ) 
  ) 
  (if (and ttx l) 
    (progn 
      (setq ttx (strcat ttx "=" (rtos l 2 2))) 
      (while (not (setq pt (getpoint "\n计算式标注点 : ")))) 
      (command "text" "j" "BC" pt (* sc 300) 0 ttx) 
    ) 
  ) 
  (CMDLA1) 
)[/FONT]

舟自横 · 发表于 2006-10-26 13:32:50

最初由雨箭风刀发布
[B]求cen也可以用(osnap pt "cen") [/B]

no!no!那樣畢竟不如算法來的保險。。。
如果有兩個靠的很近的圓弧用osnap 就容易抓錯點了。。。

账号		自动登录	找回密码
密码			立即注册

[LISP函数]：怎么获得多义线某分段的长度

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子