论坛 › A/VLISP › 四个方向取 Pline 两点间节点

eachy 发表于 2014-8-2 23:54:34

四个方向取 Pline 两点间节点

和炫翔版主聊到的一个程序，共享一下
**** Hidden Message *****

小龙龙 发表于 2014-8-3 06:07:08

学习一下

yoyoho 发表于 2014-8-3 07:22:34

感谢 eachy 副站长分享程序!

HLCAD 发表于 2014-8-3 07:34:44

本帖最后由 HLCAD 于 2014-8-22 11:45 编辑

感谢站长！我想如果用于正投影的话，将非常有用！;;; 点表pnts，沿某一角度ang（弧度）进行投影时，剔除共线的、远离的点
;;; fuzz为精度控制值.
;;; 程序编制：HLCAD，于2014.08.22
;;; 程序吸取了“元老st788796”中的trans用法；
;;; 程序用到“站长eachy”的程序的 ptl、an之后（加一行），
;;; 如：ptl (Pnts-Angle-Project ptl an 1e-06) 解决重复线的问题。
;;; 本想在后跟贴，然太远，特再编辑放到此处。
;| Ex:
(defun c:tt1 nil
(setq tmp (Pnts-Angle-Project
      (setq pnts(polyline:verts(car(entsel"\n点取多段线:"))))
      (setq ang (getangle"\n投影线角度:"))
      (setq fuzz 1e-06)
      ))
(command"_.pline") (mapcar'(lambda(x)(command"_non"x))tmp) (command"")
)
|;
;;;
(defun Pnts-Angle-Project (pnts ang fuzz / p1 p2 v Lst rtn)
(setq p1 (polar (car pnts) ang100.)
p2 (polar (car pnts) ang -100.)
)
(setq v (mapcar '- p2 p1)
Lst (mapcar '(lambda (x) (trans (mapcar '- x p1) 0 v)) pnts)
Lst (mapcar '(lambda (x) (list (car x) (caddr x))) Lst) ;去除中间值0.0
Lst (mapcar '(lambda(x y) (list x y)) Lst pnts)
)
(setq Lst (vl-sort Lst
         '(lambda (x1 x2)
      (if (equal (caar x1) (caar x2) fuzz)
      (< (cadar x1) (cadar x2))
      (< (caarx1) (caarx2))
      ))))
(setq rtn '())
(mapcar '(lambda (x)
       (if (equal (caar x) (caar(last rtn)) fuzz)
         nil
         (setq rtn (append rtn (list x)))
         )) Lst)
(mapcar 'cadr rtn)
)

czx663 发表于 2014-8-3 08:05:46

回复看看,学习一下

st788796 发表于 2014-8-3 08:15:13

正投影，只要看线需要再处理一下顶点

(defun PntsProjectTo (e pnts p1 p2 / v nl nnl)
(setq        v   (mapcar '- p2 p1)
        lst (mapcar '(lambda (x)
                     (list (last (trans (mapcar '- x p1) 0 v)) x)
                     )
                  pnts
          )
        nl(list (car lst))
        lst (cdr lst)
)
(while lst
    (if        (or (> (caar lst) (caar nl))
          (not (equal (caar lst) (caar nl) 1e-6))
        )
      (setq nl (cons (car lst) nl))
    )
    (setq nnl (cons (car lst) nnl)
          lst (cdr lst)
    )
)
(if nnl
    (list (reverse (mapcar 'cadr nl))
          (reverse (mapcar 'cadr nnl))
    )
    (list (reverse (mapcar 'cadr nl)))
)
)

auva 发表于 2014-8-3 08:42:22

不知道是否可以应用到面积分割！谢谢啦！

viphappy 发表于 2014-8-3 10:22:13

回复看看,学习一下

dwg001 发表于 2014-8-3 11:53:46

回帖，看精彩内容去。

ysq101 发表于 2014-8-3 12:18:49

这个就是投影啊。。。。。对一些特定专业很实用啊
高手

HLCAD 发表于 2014-8-3 14:00:52

st788796 发表于 2014-8-3 08:15
正投影，只要看线需要再处理一下顶点

参数E似乎没有作用？

jeen422 发表于 2014-8-3 14:33:26

怎么看不了

jeen422 发表于 2014-8-3 15:43:20

新人弱弱的问一句，怎么使用啊？命令是什么

xchj81 发表于 2014-8-3 16:27:12

感谢 eachy 副站长分享程序!:)

hzj268 发表于 2014-8-3 17:23:06

路过不错过

查看完整版本: 四个方向取 Pline 两点间节点