采集PL线上各顶点的坐标
本帖最后由 zzl9105 于 2011-10-20 14:18 编辑如题,哪位有这样的小lisp呀,想学习下,
以及我想判断一个点在不在这个闭合PL线之内,如何判断呀?
或者说我想取一个该闭合线内一点,以供函数使用,这点取点
恭请高手出招,谢谢!
http://bbs.mjtd.com/xwb/images/bgimg/icon_logo.png 该贴已经同步到 zzl9105的微博
采集PL线上各顶点的坐标
;;;****************************************************
;;; 返回多段线(*POLYLINE)的所有顶点坐标函数
;;;****************************************************
(defun GetPLineVTX (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
;;;-----------------------------------------------
;;; 获取 LWPOLYLINE 对象所有顶点坐标
;;;-----------------------------------------------
(defun GetLWPolyLineVTX (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
;;;---------------------------------------------
;;; 获取 POLYLINE 对象所有顶点坐标
;;;---------------------------------------------
(Defun GetPolyLineVTX (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 pelentData1 ;取出对象表.
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
判断一个点在不在这个闭合PL线之内
;;;******************************************************************************
;;; 判断点是否在多边形内
;;;xPt是要判断的点坐标(x y z ), Points是多边形顶点列表((x1 y1 z1) (x2 y2 z2)...)
;;;******************************************************************************
(defun isPtinPM (xPt Points)
(equal PI (abs (apply '+ (mapcar '(lambda (x y)(rem (- (angle xPt x) (angle xPt y)) PI))
(reverse (cdr (reverse (cons (last Points) Points)))) Points)))
1e-6
);end_equal
);end_defun
本帖最后由 zzl9105 于 2011-10-20 16:41 编辑
xiaxiang 发表于 2011-10-20 14:42 http://bbs.mjtd.com/static/image/common/back.gif
采集PL线上各顶点的坐标
非常感谢xiaxiang
命令: (LOAD "F:/LISP加载/练习/采集PL线上各顶点的坐标.lsp") GETPOLYLINEVTX
命令: GETPOLYLINEVTX
未知命令“GETPOLYLINEVTX”。按 F1 查看帮助。
命令: GetLWPolyLineVTX
未知命令“GETLWPOLYLINEVTX”。按 F1 查看帮助。
命令: GetPLineVTX
未知命令“GETPLINEVTX”。按 F1 查看帮助。
怎么都是未知命令,是不是不完全呀?
页:
[1]