设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › [求助]：怎样求点到直线的垂直距离
返回列表 发新帖
查看: 1131|回复: 12

[求助] [求助]：怎样求点到直线的垂直距离

[复制链接]
pxt2001
发表于 2005-6-30 16:51:17 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要 登录 才可以下载或查看，没有账号？立即注册

×
[php]
(setq en1 (car (entsel "\n请选择第一条线:")))
(setq en2 (car (entsel "\n请选择第二条线:")))
(setq da1 (entget en1))
(setq p1 (cdr (assoc 10 da1)))
(setq p2 (cdr (assoc 11 da1)))
如何求p1 p2的中点到en2的垂直距离，请高手指点。
[/php]
setq, 点到, 垂直

相关帖子

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

xyp1964
发表于 2005-6-30 18:23:09 | 显示全部楼层
[php](load "xyp_lib")
;|加载通用函数(可在签名栏直接下载)
如果已经下载xyp_lib并放到搜索路径下可以不再下载!
利用以下任何一种方式即可加载和运行通用函数内的所有子程序：
1.在acad.lsp中增加(load"xyp_lib")
2.在每个程序内增加(load"xyp_lib")
3.在command下，输入(load"xyp_lib")
4.在菜单.mnl中增加(load"xyp_lib")
5.将xyp_lib.vlx文件直接拽到cad屏幕
★通用函数下载地址：http://www.xdcad.net/forum/attachme...&postid=1606661|;

(defun c:test ()
  (setq        en1  (car (entsel "\n请选择第一条线:"))
        en2  (car (entsel "\n请选择第二条线:"))
        da1  (entget en1)
        da2  (entget en2)
        p1   (cdr (assoc 10 da1))
        p2   (cdr (assoc 11 da1))
        p11   (cdr (assoc 10 da2))
        p22   (cdr (assoc 11 da2))
        p3   (_midp p1 p2)
        p4   (polar p3 (+(angle p11 p22)(* pi 0.5))100)
        p5   (inters p3 p4 (dxf 10 da2) (dxf 11 da2) nil)
        leng (distance p3 p5)
  )
  (grvecs (list 1 p3 p5))
  leng
)
[/php]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

yshf

已领礼包: 111个

财富等级: 日进斗金
发表于 2005-6-30 20:59:19 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
;请试用以下程序:
(defun jl()
   (setq xtblm '("cmdecho"  "osmode")
         xtblz (mapcar 'getvar xtblm)
   )
   (mapcar 'setvar xtblm '(0 512))
   (setq en1 (car (entsel "\n请选择第一条线:")))
   (setq da1 (entget en1))
   (setq p1 (mapcar '(lambda(x1 x2) (/ (+ x1 x2) 2))
                     (cdr (assoc 10 da1))
                     (cdr (assoc 11 da1))
            )
   )
   (command "_dimaligned" p1
               (setq p2 (osnap (getpoint p1 "\n请选择第二条线:") "perp"))
               "t" (rtos (setq dis (distance p1 p2)) 2 3)
               p1
   )
   (mapcar 'setvar xtblm xtblz)
   dis
)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

狂刀
发表于 2005-6-30 21:16:00 | 显示全部楼层
[php](vlax-curve-getclosestpointto e2 (vlax-curve-getpointatdist e1(/ (vlax-curve-getdistatparam e1(vlax-cruve-getendparam e1)) 2)))[/php]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

yshf

已领礼包: 111个

财富等级: 日进斗金
发表于 2005-6-30 21:59:48 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
楼上的，“(vlax-curve-getclosestpointto e2 (vlax-curve-getpointatdist e1(/ (vlax-curve-getdistatparam e1(vlax-cruve-getendparam e1)) 2)))”是不是写错了，应该为：
“(vlax-curve-getclosestpointto e2 (vlax-curve-getpointatdist e1(/ (vlax-curve-getdistatparam e1
   修改为(vlax-curve-getendparam e1)) 2)))”。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

dandee
发表于 2005-6-30 23:08:32 | 显示全部楼层
(setq mp (polar p1 (angle p1 p2)  (/ (distance p1 p2) 2)))
(princ "\n Distance=") (princ (distance (vlax-curve-getClosestPointTo en2 mp) mp))
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

xyp1964
发表于 2005-7-1 00:15:45 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
  2. [FONT=courier new](load "xyp_lib")
  3. ;|加载通用函数(可在签名栏直接下载)
  4. 如果已经下载xyp_lib并放到搜索路径下可以不再下载!
  5. 利用以下任何一种方式即可加载和运行通用函数内的所有子程序：
  6. 1.在acad.lsp中增加(load"xyp_lib")
  7. 2.在每个程序内增加(load"xyp_lib")
  8. 3.在command下，输入(load"xyp_lib")
  9. 4.在菜单.mnl中增加(load"xyp_lib")
  10. 5.将xyp_lib.vlx文件直接拽到cad屏幕
  11. ★通用函数下载地址：[url]http://www.xdcad.net/forum/attachme...&postid=1606661[/url]|;

  13. (defun c:test ()
  14.   (setq        s1   (car (entsel "\n请选择第一条线:"))
  15.         s2   (car (entsel "\n请选择第二条线:"))
  16.         p1 (curve-pt s1 (/(curve-leng s1)2))
  17.         p2 (vlax-curve-getClosestPointTo (obj s2) p1 t)
  18.         leng(distance p1 p2)
  19.   )
  20.   (grvecs (list 1 P1 P2))
  21.   leng
  22. )[/FONT]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

zh_6531394
发表于 2005-7-1 10:30:25 | 显示全部楼层
为什么"点到直线的垂直距离"的点是中点而不是任意一点呢
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

pxt2001
 楼主| 发表于 2005-7-2 00:45:32 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
模仿3楼"yshf"的程序，依葫芦画瓢画了下面一段（预期功能：已知两平行直线，依次点取第一、二条线，将该直线填充。）。但在求p2点时，计算出错，又不知问题在哪里、该如何改进。贴上来请大家看看，望"yshf"及各位大侠不吝赐教。

  3. (defun c:hh (/ xtblm xtblz en1 da1 p1 p2 p3 chklay x1 x2 dis)
  4.   (setq        xtblm '("cmdecho" "orthomode" "osmode")
  5.         xtblz (mapcar 'getvar xtblm)
  6.   )
  7.   (mapcar 'setvar xtblm '(0 0 512))
  8.   (setq en1 (car (entsel "\n请选择第一条线:")))
  9.   (setq da1 (entget en1))
  10.   (setq        p1  (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2))
  11.                     (cdr (assoc 10 da1))
  12.                     (cdr (assoc 11 da1))
  13.             )
  14.         [color=blue]p2  (osnap (getpoint p1 "\n请选择第二条线:") "perp")[/color]
  15.         dis (distance p1 p2)
  16.         p3  (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2)) p1 p2)
  17.   )
  18.   (setq chklay (tblsearch "layer" "hatch"))
  19.   (if (= chklay nil)
  20.     (command "layer" "n" "hatch" "c" "8" "hatch" "")
  21.   )
  22.   (command "copy" en1 "" p1 p3)
  23.   (command "change" (entlast) "" "P" "LA" "hatch" "")
  24.   (command "pedit" (entlast) "Y" "w" (rtos dis) "")
  25.   (command "draworder" (entlast) "" "b")
  26.   (princ (strcat "\n填充双线宽为:" (rtos dis)))
  27.   (mapcar 'setvar xtblm xtblz)
  28.   (princ)
  29. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

yshf

已领礼包: 111个

财富等级: 日进斗金
发表于 2005-7-2 11:05:23 | 显示全部楼层
如果两条平行直线中的第二条直线存在时，在捕捉垂足时不会产生错误而中断程序；反之就会产生错误而中断程序中断，此时应将“p2  (osnap (getpoint p1 "\n请选择第二条线:") "perp")
”改为“p2 (getpoint p1 "\n请选择第二条线:") )”。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

zxq0220

已领礼包: 11306个

财富等级: 富甲天下
发表于 2005-7-3 10:13:08 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
试一下下面的程序，不止是对直线的垂直距离，对任意图元的垂直距离都能得到。
程序用纯LISP写成。
[php]
(DEFUN C:TEST (/ P1 P2 OLDOS)
(SETQ OLDOS (GETVAR "OSMODE"))
(SETVAR "OSMODE" 512)
(COMMAND "_UNDO" "BE")
(WHILE (SETQ P1 (GETPOINT "\nLine 1:"))
  (SETVAR "OSMODE" 128)
  (SETQ P2 (GETPOINT P1 "\nLine 2:"))
  (SETVAR "OSMODE" 0)
  (COMMAND "_DIMALIGNED" P1 P2 P1)
  (SETVAR "OSMODE" 512)
)
(COMMAND "_UNDO" "E")
(SETVAR "OSMODE" OLDOS)
(PRINC)
)
[/php]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

pxt2001
 楼主| 发表于 2005-7-3 19:49:34 | 显示全部楼层
经过各位大侠的指点，我已将该程序完成，在此谢谢大家。
以下链接为程序的功能演示
www.xdcad.net/techcenter/upload/ ... 0703194002_tech.swf

程序代码：

  3. (defun c:hh (/           xtblm xtblz en1   en2   p11         p12   p21   p22
  4.              pm1   pm2         pa    int   dis   p0         x1    x2    chklay
  5.             )
  6.   (setq        xtblm '("cmdecho" "orthomode" "osmode")
  7.         xtblz (mapcar 'getvar xtblm)
  8.   )
  9.   (mapcar 'setvar xtblm '(0 0 0))
  10.   (command "_undo" "be")
  11.   (while
  12.     (and
  13.       (setq en1 (car (entsel "\n请选择第一条线<退出>:")))
  14.       (setq en2 (car (entsel "\n请选择第二条线<退出>:")))
  15.     )
  16.      (setq
  17.        p11 (cdr (assoc 10 (entget en1)))
  18.        p12 (cdr (assoc 11 (entget en1)))
  19.        p21 (cdr (assoc 10 (entget en2)))
  20.        p22 (cdr (assoc 11 (entget en2)))
  21.        pm1 (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2)) p11 p12)
  22.        pm2 (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2)) p21 p22)
  23.        pa  (polar pm1 (+ (angle p11 p12) (* pi 0.5)) 10.0)
  24.        int (inters pm1 pa p21 p22 nil)
  25.        dis (distance pm1 int)
  26.        p0  (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2)) pm1 int)
  27.      )
  28.      (setq chklay (tblsearch "layer" "rffill"))
  29.      (if (= chklay nil)
  30.        (command "layer" "n" "rffill" "c" "8" "rffill" "")
  31.      )
  32.      (command "copy" en1 "" pm1 p0)
  33.      (command "change" (entlast) "" "p" "LA" "rffill" "")
  34.      (command "pedit" (entlast) "y" "w" (rtos dis) "")
  35.      (princ (strcat "\n填充双线宽为:" (rtos dis)))
  36.   )
  37.   (command "undo" "e")
  38.   (mapcar 'setvar xtblm xtblz)
  39.   (princ)
  40. )


论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

zh_6531394
发表于 2005-7-4 11:05:44 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
楼主;上面的程序是"填充双线"与"点到直线的垂直距离"风牛马不相及
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2025-9-28 09:29 , Processed in 0.291452 second(s), 56 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

快速回复 返回顶部 返回列表