[API应用]：向量应用－角均分线

eachy · 发表于 2003-3-6 18:00:58

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

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

×

;|
用法：($XDLSP_PolyLine_getSegAt <多义线实体名> <测试点>)
获得一个*POLYLINE线上指定一点处的“段”的信息。
对于直线段返回：(顶点索引 "kLine" 起点终点)
对于弧线段返回：(顶点索引 "kArc" 起点凸度终点)
所有返回点在UCS下。
|;
(defun $XDLSP_PolyLine_getSegAt (e pt clr / cNa
tf i nNums eTyl eSegData
el data1 data2 tf1 tf2
)
(setq cNa (car (xdrx_Object_ClassName e)))
(if (wcmatch cNa "*POLYLINE")
(progn
(setq tf t)
(if (setq tf (= cNa "POLYLINE"))
(setq tf (xdrx_polyline_ConvertFrom e)
tf2 tf
)
(setq tf t)
)
(if tf
(progn
(setq nNums (xdrx_polyline_numVerts e)
i -1
)
(setq tf1 t)
(while (and
tf1
(< i nNums)
)
(if (xdrx_polyline_onSegAt
e
(setq i (1+ i))
pt
)
(progn
(setq eTyl (xdrx_polyline_segtype e i)
eSegData (cond
((= "kLine" eTyl)
(setq data1
(xdrx_polyline_getLineSegAt e i)
data2
(xdrx_polyline_getWidthsAt e i)
)
(if (/= clr 0)
(grvecs (cons -1 data1)) ;By eachy
;|(progn
(apply
'command
(cons ".pline" data1)
)
(command "")
(if
(= "POLYLINE"
(car (xdrx_object_classname
(entlast)
)
)
)
(xdrx_polyline_ConvertFrom
(entlast)
)
)
(xdrx_polyline_setConstantWidth
(entlast)
(/
(getvar "viewsize")
64
)
)
(xdrx_entity_setcolor
(entlast)
1
)
);progn|;
) ;if
(append data1 data2)
)
((= "kArc")
; (xdrx_polyline_getArcSegAt e
; i)
(list (xdrx_polyline_getpointat e i)
(xdrx_polyline_getBulgeAt e i)
(xdrx_polyline_getpointat
e
(1+ i)
)
)
)
)
el (cons i (cons eTyl eSegData))
tf1 nil
)
)
)
)
)
)
(if tf2
(xdrx_polyline->2dpolyline e)
)
)
)
el
)
;;[API应用]向量应用－角均分线;
;;根据拾取线的位置等分角
(defun c:XDTB_JF (/ ptin3 $get_entity_point e1 e2
n m sp1 ep1 sp2 ep2
p1 p2 p3 p4 ang0 ang
rang pt p0 p00 plst2 plst1
PINT tf pint0
)
;;点表 L4 是否在三角形 p1p2p3 内
;;whether points in list 'l4' inside the triangle(p1 p2 p3).
(defun ptin3 (l4 p1 p2 p3 / ln tf)
(setq ln (max (distance p1 p3) (distance p2 p3)))
(foreach p4 l4
(cond
((<= ln (distance p3 p4)))
((inters p1 p2 p3 p4))
((equal p3 p4))
((inters p1 p2 p3 (polar p3 (angle p3 p4) ln)) (setq tf t))
)
)
tf
)
(defun $get_entity_point (str / e pt ptl tf)
(setq tf T)
(while tf
(setq e (xdrx_entsel str '((0 . "LINE,*POLYLINE"))))
(xdrx_setenttodb (car e))
(cond
((= (xdrx_getentdxf 0) "LINE")
(setq ptl (list (xdrx_getentdxf 10)
(xdrx_getentdxf 11)
(cadr (xdrx_getdist (last e) (car e)))
)
)
(setq tf nil)
)
((and (wcmatch (xdrx_getentdxf 0) "*POLYLINE")
(/= (cadr ($XDLSP_PolyLine_getSegAt (car e) (last e) 1))
"kArc"
)
)
(setq ptl (cddr ($XDLSP_PolyLine_getSegAt (car e) (last e) 1)))
(setq ptl (list (car ptl)
(cadr ptl)
(cadr (xdrx_getdist (last e) (car e)))
)
)
(setq tf nil)
)
(T (princ "\n选择实体不符合要求!"))
)
)
ptl
)
(xdrx_begin)
(xdrx_ucson)
(xdrx_sysvar_push "osmode")
(setq plst1 ($get_entity_point "\n第一条线: ")) ;点表
(setq plst2 ($get_entity_point "\n第二条线: ")) ;点表
(setq n (getint "\n均分份数[3/4/5/6/7/8/9/10]<2>: "))
(if (or (= n "") (= n nil))
(setq n 2)
)
(setq sp1 (car plst1)
ep1 (cadr plst1)
sp2 (car plst2)
ep2 (cadr plst2)
)
(setq pint (inters sp1 ep1 sp2 ep2 nil))
(setq pint0 (inters sp1 ep1 sp2 ep2))
(setq tf (if pint0
T
nil
)
)
(if pint
(progn
;;判断交点位置
(if tf
;;两直线相交
(progn
(setq p1 pint p3 pint)
(if (xdrx_vector_IsCodirectional
(mapcar '- sp1 pint)
(mapcar '- (last plst1) pint)
)
(setq p2 sp1)
(setq p2 ep1)
)
(if (xdrx_vector_IsCodirectional
(mapcar '- sp2 pint)
(mapcar '- (last plst2) pint)
)
(setq p4 sp2 )
(setq p4 ep2 )
)
);progn
;;交点在延长线上
(progn
(if (< (distance pint sp1) (distance pint ep1))
(setq p1 sp1
p2 ep1
)
(setq p1 ep1
p2 sp1
)
)
(if (< (distance pint sp2) (distance pint ep2))
(setq p3 sp2
p4 ep2
)
(setq p3 ep2
p4 sp2
)
)
)
)
;;拾取线夹角
(setq ang (/ (xdrx_vector_angle
(mapcar '- p2 pint)
(mapcar '- p4 pint)
)
n
)
)
;;临时点判断顺逆时针角度
(setq pt (polar pint
(+ (angle pint p2) ang)
(/ (distance pint p2) 2)
)
)
;;临时点是否在夹角内
(if (ptin3 (list pt) pint p2 p4)
(setq rang ang)
(setq rang (- ang))
)
(setq m 0)
(repeat (1- n)
(setq ang0 (+ (angle pint p2) (* (1+ m) rang)))
(if (> ang0 (* 2 pi))
(setq ang0 (- ang0 (* pi 2)))
)
(setq pt (polar pint ang0 (/ (distance pint p2) 2)))
(if tf
(setq p0 p1)
(setq p0 (inters p1 p3 pint pt nil))
)
(setq p00 (inters p2 p4 pint pt nil))
(xdrx_line1 p0 p00)
(setq m (1+ m))
)
)
)
(xdrx_sysvar_pop)
(xdrx_ucsoff)
(xdrx_end)
(princ)
)

;| 
   用法：($XDLSP_PolyLine_getSegAt <多义线实体名> <测试点>) 
   获得一个*POLYLINE线上指定一点处的“段”的信息。 
   对于直线段返回：(顶点索引 "kLine" 起点 终点) 
   对于弧线段返回：(顶点索引 "kArc" 起点 凸度 终点) 
   所有返回点在UCS下。 
|; 
(defun $XDLSP_PolyLine_getSegAt        (e        pt     clr    /             cNa 
                                 tf        i      nNums  eTyl   eSegData 
                                 el        data1  data2  tf1    tf2 
                                ) 
  (setq cNa (car (xdrx_Object_ClassName e))) 
  (if (wcmatch cNa "*POLYLINE") 
    (progn 
      (setq tf t) 
      (if (setq tf (= cNa "POLYLINE")) 
        (setq tf  (xdrx_polyline_ConvertFrom e) 
              tf2 tf 
        ) 
        (setq tf t) 
      ) 
      (if tf 
        (progn 
          (setq        nNums (xdrx_polyline_numVerts e) 
                i     -1 
          ) 
          (setq tf1 t) 
          (while (and 
                   tf1 
                   (
                 ) 
            (if        (xdrx_polyline_onSegAt 
                  e 
                  (setq i (1+ i)) 
                  pt 
                ) 
              (progn 
                (setq eTyl     (xdrx_polyline_segtype e i) 
                      eSegData (cond 
                                 ((= "kLine" eTyl) 
                                  (setq        data1 
                                              (xdrx_polyline_getLineSegAt e i) 
                                        data2 
                                              (xdrx_polyline_getWidthsAt e i) 
                                  ) 
                                  (if (/= clr 0) 
                                    (grvecs (cons -1 data1)) ;By eachy 
                                    ;|(progn 
                                      (apply 
                                          'command 
                                          (cons ".pline" data1) 
                                        ) 
                                        (command "") 
                                        (if 
                                          (= "POLYLINE" 
                                             (car (xdrx_object_classname 
                                                    (entlast) 
                                                  ) 
                                             ) 
                                          ) 
                                           (xdrx_polyline_ConvertFrom 
                                             (entlast) 
                                           ) 
                                        ) 
                                        (xdrx_polyline_setConstantWidth 
                                          (entlast) 
                                          (/ 
                                            (getvar "viewsize") 
                                            64 
                                          ) 
                                        ) 
                                        (xdrx_entity_setcolor 
                                          (entlast) 
                                          1 
                                        ) 
                                    );progn|; 
                                  )        ;if 
                                  (append data1 data2) 
                                 ) 
                                 ((= "kArc") 
                                        ; (xdrx_polyline_getArcSegAt e 
                                        ; i) 
                                  (list        (xdrx_polyline_getpointat e i) 
                                        (xdrx_polyline_getBulgeAt e i) 
                                        (xdrx_polyline_getpointat 
                                          e 
                                          (1+ i) 
                                        ) 
                                  ) 
                                 ) 
                               ) 
                      el       (cons i (cons eTyl eSegData)) 
                      tf1      nil 
                ) 
              ) 
            ) 
          ) 
        ) 
      ) 
      (if tf2 
        (xdrx_polyline->2dpolyline e) 
      ) 
    ) 
  ) 
  el 
) 
;;[API应用]向量应用－角均分线; 
;;根据拾取线的位置等分角 
(defun c:XDTB_JF (/ ptin3   $get_entity_point            e1            e2 
                    n            m            sp1            ep1            sp2            ep2 
                    p1            p2            p3            p4            ang0    ang 
                    rang    pt            p0            p00            plst2   plst1 
                    PINT    tf pint0 
                   ) 
 
 
  ;;点表 L4 是否在三角形 p1p2p3 内 
  ;;whether points in list 'l4' inside the triangle(p1 p2 p3). 
  (defun ptin3 (l4 p1 p2 p3 / ln tf) 
    (setq ln (max (distance p1 p3) (distance p2 p3))) 
    (foreach p4        l4 
      (cond 
        ((<= ln (distance p3 p4))) 
        ((inters p1 p2 p3 p4)) 
        ((equal p3 p4)) 
        ((inters p1 p2 p3 (polar p3 (angle p3 p4) ln)) (setq tf t)) 
      ) 
    ) 
    tf 
  ) 
  (defun $get_entity_point (str / e pt ptl tf) 
    (setq tf T) 
    (while tf 
      (setq e (xdrx_entsel str '((0 . "LINE,*POLYLINE")))) 
      (xdrx_setenttodb (car e)) 
      (cond 
        ((= (xdrx_getentdxf 0) "LINE") 
         (setq ptl (list (xdrx_getentdxf 10) 
                         (xdrx_getentdxf 11) 
                         (cadr (xdrx_getdist (last e) (car e))) 
                   ) 
         ) 
         (setq tf nil) 
        ) 
        ((and (wcmatch (xdrx_getentdxf 0) "*POLYLINE") 
              (/= (cadr ($XDLSP_PolyLine_getSegAt (car e) (last e) 1)) 
                  "kArc" 
              ) 
         ) 
         (setq ptl (cddr ($XDLSP_PolyLine_getSegAt (car e) (last e) 1))) 
         (setq ptl (list (car ptl) 
                         (cadr ptl) 
                         (cadr (xdrx_getdist (last e) (car e))) 
                   ) 
         ) 
         (setq tf nil) 
        ) 
        (T (princ "\n选择实体不符合要求!")) 
      ) 
    ) 
    ptl 
  ) 
  (xdrx_begin) 
  (xdrx_ucson) 
  (xdrx_sysvar_push "osmode") 
  (setq plst1 ($get_entity_point "\n第一条线: ")) ;点表 
  (setq plst2 ($get_entity_point "\n第二条线: ")) ;点表 
  (setq n (getint "\n均分份数[3/4/5/6/7/8/9/10]<2>: ")) 
  (if (or (= n "") (= n nil)) 
    (setq n 2) 
  ) 
  (setq        sp1 (car plst1) 
        ep1 (cadr plst1) 
        sp2 (car plst2) 
        ep2 (cadr plst2) 
  ) 
  (setq pint (inters sp1 ep1 sp2 ep2 nil)) 
  (setq pint0 (inters sp1 ep1 sp2 ep2)) 
  (setq        tf (if pint0 
             T 
             nil 
           ) 
  ) 
  (if pint 
    (progn 
      ;;判断交点位置 
      (if tf 
        ;;两直线相交 
        (progn 
          (setq p1 pint p3 pint) 
          (if (xdrx_vector_IsCodirectional 
                (mapcar '- sp1 pint) 
                (mapcar '- (last plst1) pint) 
              ) 
            (setq  p2 sp1) 
            (setq  p2 ep1) 
          ) 
          (if (xdrx_vector_IsCodirectional 
                (mapcar '- sp2 pint) 
                (mapcar '- (last plst2) pint) 
              ) 
            (setq p4 sp2 ) 
            (setq p4 ep2 ) 
          ) 
        );progn 
        ;;交点在延长线上 
        (progn 
          (if (< (distance pint sp1) (distance pint ep1)) 
            (setq p1 sp1 
                  p2 ep1 
            ) 
            (setq p1 ep1 
                  p2 sp1 
            ) 
          ) 
          (if (< (distance pint sp2) (distance pint ep2)) 
            (setq p3 sp2 
                  p4 ep2 
            ) 
            (setq p3 ep2 
                  p4 sp2 
            ) 
          ) 
        ) 
      ) 
      ;;拾取线夹角 
      (setq ang        (/ (xdrx_vector_angle 
                     (mapcar '- p2 pint) 
                     (mapcar '- p4 pint) 
                   ) 
                   n 
                ) 
      ) 
      ;;临时点判断顺逆时针角度 
      (setq pt (polar pint 
                      (+ (angle pint p2) ang) 
                      (/ (distance pint p2) 2) 
               ) 
      ) 
      ;;临时点是否在夹角内 
      (if (ptin3 (list pt) pint p2 p4) 
        (setq rang ang) 
        (setq rang (- ang)) 
      ) 
      (setq m 0) 
      (repeat (1- n) 
        (setq ang0 (+ (angle pint p2) (* (1+ m) rang))) 
        (if (> ang0 (* 2 pi)) 
          (setq ang0 (- ang0 (* pi 2))) 
        ) 
        (setq pt (polar pint ang0 (/ (distance pint p2) 2))) 
        (if tf 
          (setq p0 p1) 
          (setq p0 (inters p1 p3 pint pt nil)) 
        ) 
        (setq p00 (inters p2 p4 pint pt nil)) 
        (xdrx_line1 p0 p00) 
        (setq m (1+ m)) 
      ) 
    ) 
  ) 
  (xdrx_sysvar_pop) 
  (xdrx_ucsoff) 
  (xdrx_end) 
  (princ) 
)

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

[API应用]：向量应用－角均分线

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

相关帖子