关于多段线
本帖最后由 自贡黄明儒 于 2014-11-7 09:43 编辑;;164.1 [功能] 曲线是否封闭
;;164.2 [功能]使多段线封闭
;;164.3 [功能] 多段线端点列表
;;164.4 [功能] 矩形中点坐标
;;164.5 [功能] 参数param处的切线方向的角度
;;164.6 [功能] 参数param处的法线方向的角度
;;164.7 [功能] 曲线一点的切线方向的角度
;;164.8 [功能] 曲线一点的法线方向的角度
;;164.9 [功能] 去除多段线重点
;;164.10 [功能] 判断点是否在曲线上
;;164.11 [功能] 曲线长度
;;164.12 [功能] 多段线子段数量
;;164.13 [功能] 曲线中点
;;164.14 [功能] 曲线一点的参数param
;;164.15 [功能] 参数param处的坐标
;;164.16 [功能] 多段线第n子段的起点坐标
;;164.17 [功能] 多段线第n子段的终点坐标
;;164.18 [功能] 多段线所点击子段的两端点列表
;;164.19 [功能] 多段线所点击点最近的一个顶点
;;164.20 [功能] 多段线所点击子段param(索引)
;;164.21 [功能] 多段线所点击子段的起点坐标
;;164.22 [功能] 多段线所点击子段的终点坐标
;;164.23 [功能] 多段线所击点离起点近
;;164.24 [功能] 多段线所点击子段否是直线(返回nil是弧)
;;164.25 [功能] 求多段线上的弧段(圆或圆弧也有效)的圆心 by caoyin
;;164.26 [功能] 求多段线上的弧段(圆或圆弧也有效)的圆心
;;164.27 [功能] 判断多段线是否有圆弧(凸度/=0)的子段
;;164.28 [功能] 判断多段线是否有圆弧(凸度/=0)的子段
;;164.29 [功能] 连接线、弧成多段线
;;164.30 [功能] 构造矩形 by highflybird
;;164.31 [功能] 点表生成多段线
;;164.32 [功能] 3D多段线
;;164.33 [功能] 多段线反向(起点反成终点) byzml84
;;164.34 [功能] 多段线删除顶点
;;164.35 [功能] 多段线增加顶点
;;164.36 [功能] 多段线修改顶点
;;164.37 [功能] 多段线拷贝子段
;;164.38 [功能] 修改多段线子段
;;164.39 [功能] 修改多段线子段为直线
;;164.40 [功能] 点在封闭多段线内返回T，其余nilBy 狂刀
;;164.41 [功能] 点在封闭多段线内返回T，其余nilBy SmcTools
;;164.42 [功能] 判断点在封闭曲线内外，自交曲线不适用 By Gu_xl
;;164.43 [功能] 点在封闭多段线内返回T;线上0;外nil
;;164.44 [功能] 多段线弧段全改为直线段
;;164.45 [功能] 沿多段线取点，弧处按角度加密取点
;;164.46 [功能] 多段线自相交 by st788796
;;164.1 [功能] 曲线是否封闭 By 自贡黄明儒
;;示例(HH:isClosed (car (entsel)))
(defun HH:isClosed (obj)
(vlax-curve-isClosed obj)
)
;;164.2 [功能]使多段线封闭
(defun HH:MakeClosed (en / OBJ)
(cond ((equal (type en) 'ENAME) (setq obj (vlax-ename->vla-object en)))
((equal (type en) 'ENAME) (setq obj en))
(T (exit))
)
;;(if (equal (vlax-get obj 'Closed) 0) (vlax-put obj 'Closed -1))
(if (not (vlax-curve-isclosed obj)) ;(equal (vlax-get-property obj 'closed) :vlax-false)
(vla-put-closed obj :vlax-true)
)
)
;;164.3 [功能] 多段线端点列表 By 自贡黄明儒
;;示例(HH:PtLists (car (entsel)))
(defun HH:PtLists (en)
(mapcar 'cdr
(vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget en))
)
)
;;164.4 [功能] 矩形中点坐标 By 自贡黄明儒
;;示例(HH:RectangCen (car (entsel)))
(defun HH:RectangCen (en / PL X Y)
(setq pl (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget en)))
(setq pl (mapcar 'cdr pl))
(mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) (car pl) (caddr pl))
)
;;示例(HH:RectangCen1 (car (entsel)))
(defun HH:RectangCen1 (en / OBJ PL PL1 X Y)
(setq obj (vlax-ename->vla-object en))
(setq pl (vlax-safearray->list (vlax-variant-value (vla-get-coordinates obj))))
(setq pl1 (cddddr pl))
(mapcar '(lambda (X Y) (/ (+ X Y) 2.0))
(list (car pl) (cadr pl))
(list (car pl1) (cadr pl1))
)
)
;;164.5 [功能] 参数param处的切线方向的角度
;;示例(HH:ParamFirstAngle (car (entsel)) 1)
;;注1 (vlax-curve-getFirstDeriv obj param) 函数计算的值是曲线上在参数值为param点处的切线方向
;;注2 param起始值为0
(defun HH:ParamFirstAngle (obj param)
(setq pt (vlax-curve-getpointatparam obj param))
(angle pt (mapcar '+ pt (vlax-curve-getFirstDeriv obj param)))
)
;;164.6 [功能] 参数param处的法线方向的角度
;;示例(HH:ParamSecondAngle (car (entsel)) 1)
;;注:param处是直线，则返回0.0
(defun HH:ParamSecondAngle (obj param)
(setq pt (vlax-curve-getpointatparam obj param))
(angle pt (mapcar '+ pt (vlax-curve-getSecondDeriv obj param)))
)
;;164.7 [功能] 曲线一点的切线方向的角度
;;示例(HH:PtFirstAngle (car (entsel)) (getpoint))
(defun HH:PtFirstAngle (obj pt)
(setq param (vlax-curve-getParamAtPoint obj pt))
(angle pt (mapcar '+ pt (vlax-curve-getFirstDeriv obj param)))
)
;;164.8 [功能] 曲线一点的法线方向的角度
;;示例(HH:PtSecondAngle (car (entsel)) (getpoint))
(defun HH:PtSecondAngle (obj pt)
(setq param (vlax-curve-getParamAtPoint obj pt))
(angle pt (mapcar '+ pt (vlax-curve-getSecondDeriv obj param)))
)
;;164.9 [功能] 去除多段线重点By 自贡黄明儒
;;示例(HH:Remove (car (entsel)))
(defun HH:Remove (en / NEWDATA)
(foreach e (entget en)
(if (and (member e newdata) (= 10 (car e)))
nil
(setq newdata (cons e newdata))
)
)
(entmod (reverse newdata))
)
;;164.10 [功能] 判断点是否在曲线上
;;示例(HH:PtOnCurve (getpoint) (car (entsel)))
(defun HH:PtOnCurve (pt curve)
(equal pt (vlax-curve-getClosestPointTo curve pt) 0.00001)
)
;;164.11 [功能] 曲线长度
;;直线、圆弧、圆、多段线、优化多段线、样条曲线等图元
;;示例 (HH:GetCurveLength (car (entsel)))
(defun HH:GetCurveLength (curve)
(vlax-curve-getDistAtParam curve (vlax-curve-getEndParam curve))
)
;;164.12 [功能] 多段线子段数量
;;相当于组码90
;;示例 (HH:GetCurveNum (car (entsel)))
(defun HH:GetCurveNum (obj)
(if (vlax-curve-isClosed obj)
(fix (1- (vlax-curve-getendParam obj)))
(fix (vlax-curve-getendParam obj))
)
)
;;164.13 [功能] 曲线中点
;;示例 (HH:GetMidpointCurve (car (entsel)))
(defun HH:GetMidpointCurve (curve / d)
(setq d (/ (vlax-curve-getDistAtParam curve (vlax-curve-getEndParam curve)) 2))
(vlax-curve-getPointAtDist curve d)
)
;;164.14 [功能] 曲线一点的参数param
;;(HH:PtToParam (car (entsel)) (getpoint))
(defun HH:PtToParam (obj pt)
(vlax-curve-getParamAtPoint obj pt)
)
;;164.15 [功能] 参数param处的坐标
;;(HH:ParamTopt (car (entsel)) 0)
(defun HH:ParamTopt (obj param)
(vlax-curve-getPointAtParam obj param)
)
;;164.16 [功能] 多段线第n子段的起点坐标
;;示例 (HH:GetSegStratPt (car (entsel)) 0)
(defun HH:GetSegStratPt (curve n)
(vlax-curve-getPointAtParam curve (fix n))
)
;;164.17 [功能] 多段线第n子段的终点坐标
;;示例 (HH:GetSegEndPt (car (entsel)) 0)
(defun HH:GetSegEndPt (curve n)
(vlax-curve-getPointAtParam curve (1+ (fix n)))
)
;;164.18 [功能] 多段线所点击子段的两端点列表
;;示例(HH:PickSegEndPt (car(setq en(entsel))) (cadr en))
(defun HH:PickSegEndPt (obj p / pp n)
(setq pp (vlax-curve-getclosestpointto obj (trans p 1 0))
n(fix (vlax-curve-getparamatpoint obj pp))
)
(list (vlax-curve-getPointAtParam obj n)
(vlax-curve-getPointAtParam obj (1+ n))
)
)
;;164.19 [功能] 多段线所点击点最近的一个顶点By 自贡黄明儒
;;示例(HH:PickClosePt (car(setq en(entsel))) (cadr en))
(defun HH:PickClosePt (obj p / N P1 P2 PP)
(setq pp (vlax-curve-getclosestpointto obj (trans p 1 0))
n(fix (vlax-curve-getparamatpoint obj pp))
)
(setq p1 (vlax-curve-getPointAtParam obj n))
(setq p2 (vlax-curve-getPointAtParam obj (1+ n)))
(if (< (distance pp p1) (distance pp p2))
p1
p2
)
)
;;164.20 [功能] 多段线所点击子段param(索引)By 自贡黄明儒
;;示例(HH:PickSegIndex (car(setq en(entsel))) (cadr en))
(defun HH:PickSegIndex (obj p / PP)
(setq pp (vlax-curve-getclosestpointto obj (trans p 1 0)))
(fix (vlax-curve-getparamatpoint obj pp))
)
;;164.21 [功能] 多段线所点击子段的起点坐标By 自贡黄明儒
;;示例(HH:PickSegStratPt (car(setq en(entsel))) (cadr en))
(defun HH:PickSegStratPt (obj p / pp n)
(setq pp (vlax-curve-getclosestpointto obj (trans p 1 0))
n(fix (vlax-curve-getparamatpoint obj pp))
)
(vlax-curve-getPointAtParam obj n)
)
;;164.22 [功能] 多段线所点击子段的终点坐标 By 自贡黄明儒
;;示例(HH:PickSegEndPt (car(setq en(entsel))) (cadr en))
(defun HH:PickSegEndPt (obj p / pp n)
(setq pp (vlax-curve-getclosestpointto obj (trans p 1 0))
n(fix (vlax-curve-getparamatpoint obj pp))
)
(vlax-curve-getPointAtParam obj (1+ n))
)
;;164.23 [功能] 多段线所击点离起点近 By 自贡黄明儒
;;示例(HH:PickToStart (car(setq en(entsel))) (cadr en))
(defun HH:PickToStart (curve p / L1 L2 PP)
(setq pp (vlax-curve-getclosestpointto curve (trans p 1 0)))
(setq L2 (vlax-curve-getDistAtParam curve (vlax-curve-getEndParam curve)))
(setq L1 (vlax-curve-getDistAtPoint curve pp))
(> (- L2 L1) L1)
)
;;164.24 [功能] 多段线所击子段是否是直线(返回nil是弧) By 自贡黄明儒
;;示例(HH:PickArc (car(setq en(entsel))) (cadr en))
(defun HH:PickArc (curve p / PP)
(setq pp (vlax-curve-getclosestpointto curve (trans p 1 0)))
(setq pp (vlax-curve-getSecondDeriv
curve
(fix (vlax-curve-getparamatpoint curve pp))
)
)
(equal pp '(0.0 0.0 0.0))
)
;;164.25 [功能] 求多段线上的弧段(圆或圆弧也有效)的圆心 by caoyin
;;(HH:GetCenter1 (entsel "\n选择多段线弧段: "))
(defun HH:GetCenter1 (EP / E P)
(mapcar 'set '(E P) EP)
(setq P (apply 'vlax-curve-getClosestPointTo EP))
(mapcar '+
P
(vlax-curve-getsecondderiv
E
(vlax-curve-getParamAtPoint E P)
)
)
)
;;164.26 [功能] 求多段线上的弧段(圆或圆弧也有效)的圆心
;;(HH:GetCenter2 (car(setq en(entsel))) (cadr en))
(defun HH:GetCenter2 (curve p / PP)
(setq pp (vlax-curve-getclosestpointto curve (trans p 1 0)))
(mapcar '+
pp
(vlax-curve-getsecondderiv
curve
(vlax-curve-getParamAtPoint curve pp)
)
)
)
;;164.27 [功能] 判断多段线是否有圆弧(凸度/=0)的子段
;;(HH:checkarc1 (car (entsel)))
(defun HH:checkarc1 (en / BU N OBJ PLIST)
(setq obj (vlax-ename->vla-object en))
(setq plist (vlax-safearray->list (vlax-variant-value (vla-get-coordinates obj))))
(setq n 0)
(repeat (/ (length plist) 2)
(if (/= (vla-getbulge obj n) 0)
(setq bu T)
)
(setq n (+ n 1))
)
bu
)
;;164.28 [功能] 判断多段线是否有圆弧(凸度/=0)的子段
;;(HH:checkarc2 (car (entsel)))
(defun HH:checkarc2 (en / G)
(setq G (vl-remove-if-not '(lambda (x) (= (car x) 42)) (entget en)))
(not (vl-every 'zerop (mapcar 'cdr G))) ;(vl-remove 0.0 (mapcar 'cdr G))
)
;;164.29 [功能] 连接线、弧成多段线
;;(HH:JionToPolyline)
(defun HH:JionToPolyline (/ PET SS)
(setq pet (getvar "PEDITACCEPT"))
(setvar "PEDITACCEPT" 1)
(while (setq ss (ssget '((0 . "ARC,*LINE"))))
(command "_.pedit" (ssname ss 0) "j" ss "" "")
)
(setvar "PEDITACCEPT" pet)
(princ)
)
;;164.30 [功能] 构造矩形 by highflybird
(defun Make-Rectange (pt1 pt2)
(entmake
(list
'(0 . "LWPOLYLINE") ;轻多段线
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(90 . 4) ;四个顶点
'(70 . 1) ;闭合
(cons 38 (caddr pt1)) ;高程
(cons 10 (list (car pt1) (cadr pt1))) ;左下角
(cons 10 (list (car pt2) (cadr pt1))) ;右下角
(cons 10 (list (car pt2) (cadr pt2))) ;右上角
(cons 10 (list (car pt1) (cadr pt2))) ;左上角
(cons 210 '(0 0 1)) ;法线方向
)
)
)
;;164.31 [功能] 点表生成多段线
(defun Make-LWPOLYLINE (lst / PT)
(entmake (append (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length lst))
)
(mapcar '(lambda (pt) (cons 10 pt)) lst)
)
)
)
;;164.32 [功能] 多段线反向(起点反成终点) byzml84
;;(HH:LWPOLYLINEFX (car (entsel)))
(defun HH:LWPOLYLINEFX (EN / A B C D ENT LST LST1 TMP)
(setq ENT (entget EN))
(setq tmp ent)
(while (setq tmp (member (assoc 10 tmp) tmp))
(setq a (assoc 10 tmp)
b (cons 40 (cdr (assoc 41 tmp)))
c (cons 41 (cdr (assoc 40 tmp)))
d (cons 42 (- (cdr (assoc 42 tmp))))
LST (append (list b c d a) LST)
)
(setq tmp (cddddr tmp))
)
(repeat 3 (setq LST (append (cdr lst) (list (car lst)))))
(setq lst1 (reverse (cdr (member (assoc 10 ent) (reverse ent)))))
(entmod (append lst1 lst '((210 0 0 1))))
)
**** Hidden Message *****
;;多段线自相交 by st788796
(defun rrr (e / getlst ep obj pts ptl pams il)
(defun Getlst (n / i il)
(setq i (fix n))
(repeat i (setq il (cons (setq n (1- n)) il)))
il
)
(setq obj (vlax-ename->vla-object e)
ep(vlax-curve-getendparam e)
)
(if (setq pts (vlax-invoke obj 'IntersectWith obj 0))
(progn
(while pts
(setq ptl (cons (list (car pts) (cadr pts) (caddr pts)) ptl)
pts (cdddr pts)
)
)
(setq il(cdr (getlst ep))
pams (mapcar '(lambda (x)
(vlax-curve-getparamatpoint e x)
)
ptl
)
)
(if (vlax-curve-isclosed e)
(not (equal (reverse pams)
(cons 1. (cons 0. (cdr il)))
)
)
(not (equal (vl-remove '0. (reverse pams)) il)) ;_假闭合情况
)
)
)
) 黄工再看看我那 11 楼，这是我找的与多线相关的程序，不成敬意
;;;****************************************************
;;; 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 hehoubin 发表于 2013-11-1 21:47
求这几个 黄大侠能不能贴出来呀;;164.31 [功能] 点表生成多段线
;;164.32 [功能] 多段线反向(起点反成终点 ...
能否实现两条点数不同的多段线间平均插入N条多段线 部分舆全部 发表于 2014-11-6 23:14
问下黄老师，首尾相连的多段线如何闭合成封闭的多段线
命令pe？ 占位:示例示例示例 不全啊，老黄 ynhh 发表于 2013-10-31 14:12 static/image/common/back.gif
黄工再看看我那 11 楼，这是我找的与多线相关的程序，不成敬意
;;;***************************** ...
(defun isInorOut
好象是caoyin的，没有用射线法吧？“射线”是你加的？ 好象是caoyin的，没有用射线法吧？“射线”是你加的？
你这对些程序的出处都知道是那个写的啊
感觉一些成功的程序，都混杂着多位朋友的才华
这些程序也是从网上找的，不是我加的
你看上就测试收纳啊 学习 了。黄大侠， 求这几个 黄大侠能不能贴出来呀;;164.31 [功能] 点表生成多段线
;;164.32 [功能] 多段线反向(起点反成终点) byzml84
;;164.33 [功能] 多段线删除顶点
;;164.34 [功能] 多段线增加顶点
;;164.35 [功能] 多段线修改顶点
;;164.36 [功能] 多段线拷贝子段
;;164.37 [功能] 修改多段线子段
;;164.38 [功能] 修改多段线子段为直线 ;;164.30 [功能] 构造矩形 by highflybird
;;164.31 [功能] 点表生成多段线
;;164.32 [功能] 多段线反向(起点反成终点) byzml84
;;164.33 [功能] 多段线删除顶点
;;164.34 [功能] 多段线增加顶点
;;164.35 [功能] 多段线修改顶点
求这几个，能否贴出来呀
;;164.36 [功能] 多段线拷贝子段
;;164.37 [功能] 修改多段线子段
;;164.38 [功能] 修改多段线子段为直线