changch 发表于 2004-10-29 16:42:00

非常感谢meflying为我解决了这个难题!*请求明总为meflying加分*

本帖最后由 作者 于 2004-11-1 9:04:35 编辑

已知 两条平行直线,我想从中间部分画出两条与之垂直的线



点取第一条线上的中间部分的一点


点取另一条线上的另一点


其它见图


希望你来挑战,先谢了


meflying 发表于 2004-10-29 17:35:00

(vl-load-com)
(defun c:test( / ent1 ent2 pt1 pt2 pt3 pt4 pt5 ang1 ang2)
   (setvar "cmdecho" 0)
   (command "_.undo" "be")   
   (setq os (getvar "osmode"))   
   (setq pt1 (getpoint "选择第一点:"))
   (setq pt2 (getpoint pt1 "选择第二点:"))
   (setvar "osmode" 0)
   (setq ent1 (ssname (ssget pt1 '((0 . "LINE"))) 0))
   (setq ent2 (ssname (ssget pt2 '((0 . "LINE"))) 0))
   (setq pt3 (vlax-curve-getClosestpointTo ent2 pt1))
   (setq ang1 (angle pt1 pt3))
   (setq ang2 (angle pt3 pt2))
   (setq pt4 (polar pt3 ang2 2.5))
   (setq pt5 (polar pt1 ang2 2.5))
   (command "_.line" (polar pt1 (+ ang1 pi) 2.5) (polar pt3 ang1 2.5) "")
   (setq ent3 (entlast))
   (command "_.line" (polar pt5 (+ ang1 pi) 2.5) (polar pt4 ang1 2.5) "")
   (setq ent4 (entlast))
   (setq dist (distance pt1 pt3))
   (setq pt4 (polar pt3 ang2 1.25))
   (setq pt5 (polar pt1 ang2 1.25))
   (command "_.trim" ent3 ent4 "" (list ent1 pt5) (list ent2 pt4)"")
   (setvar "osmode" os)
   (command "_.undo" "e")
)

changch 发表于 2004-11-1 09:02:00

非常感谢meflying!!!!


<BR>献花以表致谢!!!!


<BR>*****请求明总为meflying加分*****

龙龙仔 发表于 2004-11-1 15:39:00

<P class=MsoNormal style="MARGIN: 0cm 0cm 0pt">在明经加分并不容易,等你当版主时再加吧!<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>


<P class=MsoNormal style="MARGIN: 0cm 0cm 0pt">而且程式并没有写好,有时两线会长短不一,两线间宽度也会变动<o:p></o:p>

meflying 发表于 2004-11-1 16:12:00

程序是粗糙了点...


不过你说的那两种情况还没出现过,而且这些点都是计算出来的,怎么可能会呢?

龙龙仔 发表于 2004-11-1 17:11:00

我也要研究一下!就是会发生我所述!

meflying 发表于 2004-11-1 17:17:00

你说的情况我怎么都试不出来,不过有别的问题,就是选点的时候如果在垂足点就要出现问题了,或者点处选不到对象也会有问题,不过只要用的时候注意点,按要求进行选择,应该就不会出问题了啊...

龙龙仔 发表于 2004-11-2 07:51:00

;;MEFLYING
;;由於PT2,PT3非常非常接近,使ANG2变大了,而不等於0
;;这样的错误====>真是晕倒!!!         8-(;|
指令: TEST
选择第一点:------>选1的中点
选择第二点:------>选2的中点
(89.1139 289.075 0.0)
(89.1139 339.075 0.0)
(89.1139 339.075 0.0)
1.5708--->ang1
89.11385688182042,339.0754448543191,0
89.11385688182036,339.0754448543191,0
0.785398----ang2
(90.8816 340.843 0.0)
(90.8816 290.843 0.0)
(89.9977 339.959 0.0)
(89.9977 289.959 0.0) nil
|;(vl-load-com)
(defun C:TEST (/ ENT1 ENT2 PT1 PT2 PT3 PT4 PT5 ANG1 ANG2)
   (setvar "cmdecho" 0)
   (command "_.undo" "be")
   (setvar "osmode" 39)      ;抓取模式 add LUCAS
   (setq OS (getvar "osmode"))
   (setq PT1 (getpoint "选择第一点:"))
   (setq PT2 (getpoint PT1 "选择第二点:"))
   (setvar "osmode" 0)
   (setq ENT1 (ssname (ssget PT1 '((0 . "LINE"))) 0))
   (setq ENT2 (ssname (ssget PT2 '((0 . "LINE"))) 0))
   (setq PT3 (vlax-curve-getclosestpointto ENT2 PT1))
   (print PT1)
   (print PT2)
   (print PT3)
   (setq ANG1 (angle PT1 PT3))
   (print ANG1)
   (print)
   (prompt (strcat (rtos (car PT2) 2 20)
       ","
       (rtos (cadr PT2) 2 20)
       ","
       (rtos (last PT2) 2 20)
   )
   )
   (print)
   (prompt (strcat (rtos (car PT3) 2 20)
       ","
       (rtos (cadr PT3) 2 20)
       ","
       (rtos (last PT3) 2 20)
   )
   )
   (setq ANG2 (angle PT3 PT2))
   ;;由於PT2,PT3非常非常接近,使ANG2变大了,而不等於0
   ;;真是晕倒!!!
   (print ANG2)
   (setq PT4 (polar PT3 ANG2 2.5))
   (print PT4)
   (setq PT5 (polar PT1 ANG2 2.5))
   (print PT5)
   (command "_.line"
       (polar PT1 (+ ANG1 pi) 2.5)
       (polar PT3 ANG1 2.5)
       ""
   )
   (setq ENT3 (entlast))
   (command "_.line"
       (polar PT5 (+ ANG1 pi) 2.5)
       (polar PT4 ANG1 2.5)
       ""
   )
   (setq ENT4 (entlast))   (setq DIST (distance PT1 PT3))
   (setq PT4 (polar PT3 ANG2 1.25))
   (print PT4)
   (setq PT5 (polar PT1 ANG2 1.25))
   (print PT5)
   (command "_.trim"
       ENT3
       ENT4
       ""
       (list ENT1 PT5)
       (list ENT2 PT4)
       ""
   )
   (setvar "osmode" OS)
   (command "_.undo" "e")
)
测试图

meflying 发表于 2004-11-2 08:41:00

这个错误不是很丢人吧,只是不够完善而已...你好象没看我7楼的话,,,


ang2本来就不一定等于0的,我使用pt3到pt2的角度,就是要让PT2来确定打断的方向,其实就是漏了如果PT2等于PT3的时候,方向就是直线2的方向而已......你图中的情况就可以完全当PT2等于PT3来处理

龙龙仔 发表于 2004-11-2 10:40:00

但我会画出这样的图


页: [1] 2
查看完整版本: 非常感谢meflying为我解决了这个难题!*请求明总为meflying加分*