选择一个多段线后,自动识别出哪一段是直线,哪一自动段是曲线

ynhh

黄工说法难理解啊，我测试的多线只是连续但都没封闭啊？经测试，不封闭的才减一，封闭的就对了哈
感谢黄工的热心，你看这些相关程序，如对你的收纳有用，我将很高兴。。。
;;;****************************************************
;;; No.23-4 返回多段线(*POLYLINE)的所有顶点坐标 函数
;;;****************************************************
(defun ayGetPLineVTX (EntName1 / Obj1 vtx vtxlst PtsList i)
(cond
   ((= (cdr (assoc 0 (entget EntName1))) "LWPOLYLINE")
   (setq PtsList (ayGetLWPolyLineVTX EntName1))
   );end_switch
   ((= (cdr (assoc 0 (entget EntName1))) "POLYLINE")
   (setq PtsList (ayGetPolyLineVTX EntName1))
   );end_switch
);end_cond
(setq PtsList PtsList)
);end_defun

;;;-----------------------------------------------
;;; No.23-4-1 获取 LWPOLYLINE 对象所有顶点坐标   
;;;-----------------------------------------------
(defun ayGetLWPolyLineVTX (EntName1 / Obj1 vtx vtxlst PtsList i)
(vl-load-com)
(setq Obj1 (vlax-ename->vla-object EntName1))
(setq vtx (vla-get-Coordinates Obj1))
(setq vtxLst (vlax-safearray->list (vlax-variant-value vtx)))
(setq i 0)
(setq PtsList nil)
(repeat (/ (length vtxLst) 2)
   (setq PtsList (append PtsList (list (list (nth i vtxLst) (nth (1+ i) vtxLst)))))
   (setq i (+ i 2))
);end_repeat
(setq PtsList PtsList)
);end_defun

;;;---------------------------------------------
;;; No.23-4-2 获取 POLYLINE 对象所有顶点坐标   
;;;---------------------------------------------
(Defun ayGetPolyLineVTX (LwPolyEntName / entData1 entName1 pel ptp wpl wpll plp par ct
                          pen rl pn clk pt al gx bj np xc gg rr cp retList)
(setq entName1 LwPolyEntName)
(setq retList nil)
(setq entData1 (entget entName1))
(if (= "POLYLINE" (Cdr (Assoc 0 entData1)))
   (progn
    (setq pel entData1             ;取出对象表.
         ptp (Cdr (Assoc 70 pel)) ;取出结束片段型.
         wpl '()                  ;自建的点位数表.
       wpll '()
       entName1 (EntNext entName1)
       pen entName1
    );end_setq
    (While (/= "SEQEND" (Cdr (Assoc 0 (entget pen))));如果没束.
     (setq pel (entget pen)               ;取得顶点对象数据表.
           plp (Cdr (Assoc 10 pel))       ;取出控制点点位.
           par (Cdr (Assoc 42 pel))       ;取出弓弦比.
           wpl (Cons (List plp par) wpl) ;将数据加到WPL表中.
        wpll (cons plp wpll)
     );end_setq
     (setq pen (EntNext pen));搜索下一个对象.
    );end_while
    (setq wpll (Reverse wpll))

    ;以下代码暂时没有用！
    (setq ct (If (= 0 (Cadr (Car wpl))) "直线片段封闭" "弧片段封闭"))
    (setq wpl (Cons (Last wpl) wpl);加入封闭点.
        wpl (Reverse wpl)        ;整理WPL表.
         rl (Length wpl)
         pn 0
    );end_setq
    (setq clk (If (Or (= 0 ptp) (= 128 ptp)) "开口" "封闭"))
    (Repeat (1- rl)          ;逐点分析.
     (setq al (Nth pn wpl) ;取出点数据表.
           pt (Car al)      ;取出点位.
     );end_setq
     (If (And (/= 0.0 (Cadr al)) (Nth pn wpl)) ;如果是断.
       (Progn (setq gx (Cadr al)               ;取出弓比.
                    bj (* (ATAN (ABS gx)) 4)   ;计算包角.
                    np (Car (Nth (1+ pn) wpl)) ;取出下一点位.
                    xc (* 0.5 (Distance pt np));半弦长计算.
                    gg (* gx xc)               ;弓高计算.
                    rr (/ (+ (* xc xc)(* gg gg)) (* 2 gg))
               );end_setq
               (setq cp (Polar pt (setq pa (Angle pt np)) xc)
                     cp (Polar cp (+ pa (* 0.5 PI)) (- rr gg))
               );end_setq
       );end_progn
     );end_if
      (setq pn (1+ pn))
    );end_repeat
   
    (setq retList wpll)
   );end_progn
);end_if
);end_defun


;;;88888888888888888888888888
;;;
;;;以下功能测试与上部相同但很简单啊
;;;
;;;88888888888888888888888888

;;;http://hi.baidu.com/123523058/item/7d995410b5506afa9c778ac4
;;;================================
;;;功能：获取多段线顶点列表(未考虑闭合)
(defun PLINE-GETPTLST (EN / LST ENT N)
    (setq LST '()
   ENT (entget EN)
    )
    (foreach N ENT
(if (= (car N) 10)
     (setq LST (cons (cdr N) LST))
)
    )
    ;;返回
    (reverse LST)
)
;;;================================

(setq ss (ssget))
(setq i 0)
(sslength ss)
(setq ssn (ssname ss i))
(PLINE-GETPTLST SSN)


((2668.14 381.333) (2812.11 555.782) (2849.35 452.435) (2814.6 366.451) (2754.22 306.074))
((2668.14 381.333) (2812.11 555.782) (2849.35 452.435) (2814.6 366.451) (2754.22 306.074))

;;;88888888888888888888888888888888888



返回多段线的各顶点
(vertexs SSN)

   说明:
返回多段线的各顶点

   函数内容:
(defun vertexs (ename / plist pp n)        
   (setq obj (vlax-ename->vla-object ename))
   (setq plist (vlax-safearray->list
   (vlax-variant-value
     (vla-get-coordinates obj))))
   (setq n 0)
   (repeat (/ (length plist) 2)
     (setq pp (append pp (list (list (nth n plist)(nth (1+ n) plist)))))
     (setq n (+ n 2))
   )
   pp
)

   参数:
ename:图元名

   返回值:
各顶点形成的列表

;;;88888888888888888888888888888888888




;;-----------------------------------------------------------------------------------------------------------

;;功能返回多段线各个顶点坐标组成的表

;; ename—图元名 (hj_ddx_pt SSN)

(defun hj_ddx_pt (ename / plist pp n)   

   (setq obj (vlax-ename->vla-object ename))

   (setq plist (vlax-safearray->list (vlax-variant-value (vla-get-coordinates obj))))

   (setq n 0)

   (repeat (/ (length plist) 2)

     (setq pp (append pp (list (list (nth n plist)(nth (1+ n) plist)))))

     (setq n (+ n 2))

   )

   pp

)

;;-----------------------------------------------------------------------------------------------------------


;;;88888888888888888888888888888

coordsofsegbypick 返回多义线所点击子段的端点坐标

   语法:
(coordsofsegbypick ename p)

   说明:
返回多义线所点击子段的端点坐标

   函数内容:
(defun coordsofsegbypick (ename p)
   (setq obj (vlax-ename->vla-object ename)
         pp (vlax-curve-getclosestpointto obj (trans p 1 0))
           n (fix (vlax-curve-getparamatpoint obj pp)))
   (segcoord obj n)
)

   参数:
ename:图元名
p:点

   返回值:
坐标列表
;;;88888888888888888888888888888
;;-----------------------------------------------------------------------------------------------------------



;;;88888888888888888888888888888
numbersofseg 返回多段线子段的数量




   语法:

(numbersofseg SSN);在此返回段数

   说明:

返回多段线子段的数量

   函数内容:

(defun numbersofseg (ename)  

   (setq obj (vlax-ename->vla-object ename))

   (setq plist (vlax-safearray->list

   (vlax-variant-value

     (vla-get-coordinates obj))))

   (1- (/ (length plist) 2))

)

   参数:

ename:图元名

   返回值:

子段数量的整数


;;;88888888888888888888888888888




;;功能返回多段线第n个顶点坐标

;; ename—图元名

;; n—顶点序号

(hj_ddx_n_pt SSN 3)

(defun hj_ddx_n_pt (ename n)

   (setq obj (vlax-ename->vla-object ename))

   (setq plist (vlax-safearray->list (vlax-variant-value (vla-get-coordinates obj))))

   (list (nth (* n 2) plist)(nth (1+ (* n 2)) plist))
)
;;-----------------------------------------------------------------------------------------------------------


;;-----------------------------------------------------------------------------------------------------------
;;;返回多段线第n子段的两个端点坐标函数

;; LwPolyEntName —图元名
(hj_LwPoly_n_pt SSN 3)

(defun hj_LwPoly_n_pt(LwPolyEntName n / Obj Ptlist sPt ePt)

(setq obj (vlax-ename->vla-object LwPolyEntName))

(setq sPt (vlax-safearray->list (vlax-variant-value (vla-get-coordinate obj (- n 1)))))

(setq ePt (vlax-safearray->list (vlax-variant-value (vla-get-coordinate obj n))))

(setq Ptlist (list sPt ePt))

);end_defun
;;-----------------------------------------------------------------------------------------------------------

;;;8888888888888888888888888888888

coodsofsegbynum 返回多段线第n子段的端点坐标


语法:
(coodsofsegbynum obj n)
   说明:

返回多段线第n子段的端点坐标
   函数内容:

(defun coodsofsegbynum (obj n)  
   (vlax-safearray->list
               (vlax-variant-value
                 (vla-get-coordinate obj 2)))
)
   参数:

obj:图元名
n:代表子段位置的整数
   返回值:

坐标列表

;;;8888888888888888888888888888888


判断点在多边形的位置之完全版



;判断点在多边形的位置:内、外、线上
;返回值:内:1、外:-1、线上:0
;;方法1----射线法;
;;点是否在多边形内
;;点 P 是否在多边形 PM 内
;;If 'p' is in 'pm', return T.
;;'mx' is a very long distance.
(defun isInorOut (p pm / i p1 p2 tf tf1 tf2 px jp ret)
   (setq     px (list (+ 1e+100 (car p)) (cadr p))
    p1 (last pm)
    i -1
  )


   (while (and (not ret)
           (setq p2 (nth (setq i (1+ i)) pm))
     )
     (if     (setq jp (inters px p p1 p2))
       (if (equal (car jp) (car p) 0.0001)
     (setq ret t)
         (setq tf2 (if (> (cadr p1) (cadr p2)) 1 0)
          tf (if (= tf1 tf2) tf (not tf))
          tf1 tf2
        )
       )
       (setq tf1 nil)
     )
     (setq p1 p2)
   )

   (cond
    (ret 0)                ;线上
    (tf 1)                 ;内
    (t -1)                 ;外
  )
)


;;方法2---角度法
;;点是否在多边形内   
(defun ptinpm (pt lst / i p1 p2 an anl ret)
   (setq i -1 p1 (last lst))
   (while (and (not ret)
           (setq p2 (nth (setq i (1+ i)) lst))
     )
     (cond
      ((equal p2 pt 1e-4) (setq ret t))
       (t
        (setq an (- (angle pt p1) (angle pt p2)))
         (if (equal pi (abs an) 1e-4)
       (setq ret t)
       (setq anl (cons (rem an PI) anl))
     )
       )
     )
     (setq p1 p2)
   )
   (cond
    (ret 0)                ;线上;
     (t
      (if (equal PI (abs (apply '+ anl)) 1e-4)
         1                  ;内;
         -1                 ;外;
       )
     )
   )
)
   

;测试

(DEFUN C:tt (/ Curve Pt lst a b c)
   (IF (SETQ Curve (CAR (ENTSEL "\n选择一条曲线:")))(progn
       (setq lst (MAPCAR (FUNCTION CDR)
                     (VL-REMOVE-IF (FUNCTION (LAMBDA (x) (/= 10 (CAR x)))) (entget Curve))
                 )
       )
     (WHILE (SETQ Pt (GETPOINT "\n点取测试点:"))
       (setq pt (list (car pt) (cadr pt))
         c 1
       )

       (setq a (ptinpm Pt lst))
       (princ "\nxd-point_inm:")    (princ (cond ((= 0 a) "线上")
                                 ((= 1 a) "内")
                                 (t "外")))
      
       (setq a (xd-point_inm Pt lst))
       (princ "\nptinpm:") (princ (cond ((= 0 a) "线上")
                                 ((= 1 a) "内")
                                 (t "外")))
      
     )
   ))
   (PRINC)
)



论坛上的相关判断函数未包含判断点是否在多边形线上
该函数同时判断点在多边形线的位置三种可能：
1. 点在内部；
2. 点在外部；
3. 点在线上。



;;;8888888888888888888888888888888

logoin

ynhh 发表于 2013-10-31 12:40
logoin 大师你好：我参考以下程序，在你程序中加入个 1- 感觉就对了，请你验证指点。

numbersofseg 返回 ...

说得有道理，对于非封闭的线应该减1，程序如下
多段线的操作，最好还是用ARX，或者ARX.net会容易和高效些
对多段线的一般操作比如，判断时针，自相交检查，反向，优化，切割，布尔运算，等等LISP是很难实现的

(defun c:ff()
(vl-load-com)
(if (and (setq plEnt(car (entsel))) (= (cdr (assoc 0 (entget plEnt))) "LWPOLYLINE" ))
  (progn
    (setq plObj (vlax-ename->vla-object plEnt))
    (setq index 0)
    (setq plptNum (/ (vl-list-length (vlax-safearray->list (vlax-variant-value (vla-get-Coordinates plObj)))) 2))
    (if (= (vla-get-closed plObj) :vlax-false) (setq plptNum (1- plptNum)))
    (while (< index plptNum)
      (setq plBulge (vla-getbulge plObj index))
      (if (= plBulge 0)
        (print (strcat "第 " (itoa (1+ index )) " 段是直线"))
        (print (strcat "第 " (itoa (1+ index )) " 段是弧"))
      )
      (setq index (1+ index))
    )
  )
  )
  (princ)
  )

ynhh

logoin 发表于 2013-10-31 22:14
说得有道理，对于非封闭的线应该减1，程序如下
多段线的操作，最好还是用ARX，或者ARX.net会容易和高效些 ...

真心感谢您的热心指点，我昨晚是用此判断封闭与否的，(IF (= 1 (logand 1 (cdr (assoc 70 (entget plEnt)))));判断多线是否封闭。
但与大师你的代码相比，你的真是高深精简，充满智慧。
真心感谢你的指点，祝你身体健康，工作顺利。