[求助大侠]如何在lsp编程中点取求取垂直点

lihuixun · 发表于 2009-9-17 12:07:00

想在lsp中实现下面功能：在图中点取两个点，其中第一个点任意点取，二个点为垂直于图中直线的点（即1二点连成的线要垂直于图中已有直线)

非常感谢！

TANER · 发表于 2009-9-17 13:58:00

(defun c:test2 (/ txt-per lst obj pt pt2)
(defun txt-per (pt obj / pt2 dist)
(if (and
pt
obj
)
(setq dist (distance pt (setq pt2
(vlax-curve-getclosestpointto obj pt t)
)
)
)
)
(list dist pt2)
)
(if (setq obj (car (entsel "\n请点取直线："))
pt (getpoint "\n点取非直线上任意点：")
)
(progn
(setq lst (txt-per pt obj))
(setq pt2 (cadr lst))
(entmakex (list '(0 . "LINE") '(100 . "AcDbEntity") '(100 . "AcDbLine")
(cons 10 pt) (cons 11 pt2) '(210 0. 0. 1.)
)
)
(princ "\n垂足为：")
pt2
)
)
)

liu_kunlun · 发表于 2009-9-17 14:10:00

(defun c:tt ( / pt1)
(setq pt1 (vlax-curve-getClosestPointTo (vlax-ename->vla-object (car (entsel "选择线:")))
       (setq pt0 (getpoint "指定向外点:"))))
(command "line" pt0 pt1 "")
)
;;或:
(defun c:ttt (/ ent pt pt0 pt1)
(setq ent (setq ent (entsel "选择线:"))
      pt (cadr ent)
      ent (car ent)
)
(setq pt0 (vlax-curve-getClosestPointTo (vlax-ename->vla-object ent) pt))
(setvar "snapang" (angle (cdr (assoc 10 (entget ent))) (cdr (assoc 11 (entget ent)))))
(setvar "ORTHOMODE" 1)
(setq pt1 (getpoint pt0 "另一点:"))
(command "line" pt0 pt1 "")
)

lihuixun · 发表于 2009-9-17 14:42:00

非常感谢2位，已用上，确实管用，再次谢谢

asdfxx · 发表于 2009-9-17 14:47:00

提示: 作者被禁止或删除内容自动屏蔽

lihuixun · 发表于 2009-9-18 09:27:00

还是再感谢，好心的朋友

老张头头 · 发表于 2020-2-5 13:57:55

刚需要学习了

sunny_8848 · 发表于 2020-2-6 20:52:07

我使用时提示 no function definition: VLAX-ENAME->VLA-OBJECT

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

[基础] [求助大侠]如何在lsp编程中点取求取垂直点

浏览过的版块

asdfxx asdfxx 当前离线积分 2242 明经币个注册时间 2009-7-22 在线时间小时威望金钱个贡献激情	发表于 2009-9-17 14:47:00 \| 显示全部楼层提示: 作者被禁止或删除内容自动屏蔽

	回复支持反对使用道具举报显身卡