几何尺寸与公差论坛------致力于产品几何量公差标准GD&T (GDT:ASME)|New GPS(ISO)研究/CAD设计/CAM加工/CMM测量

几何尺寸与公差论坛------致力于产品几何量公差标准GD&T (GDT:ASME)|New GPS(ISO)研究/CAD设计/CAM加工/CMM测量 (http://www.dimcax.com/hust/index.php)
-   ObjectARX(AutoLISP) (http://www.dimcax.com/hust/forumdisplay.php?f=178)
-   -   求两条线延长相连的命令 (http://www.dimcax.com/hust/showthread.php?t=12266)

yang686526 2009-04-27 09:55 AM

求两条线延长相连的命令
 
求两条线延长相连的命令
www.dimcax.com
求两条线延长相连的命令
两条线,移动一条的端点与另一条的端点重合,用鼠标很容易实现,但命令不知道,想做lisp程序如下图让一个端点移动
@---------------------@ @-----------------@ @-------------------------@-----------------------------------@


d
比较粗糙的:
(defun c:test ( / poi1 poi2 select1 first_point last_point)
(setq poi1 (getpoint "\nfirst point:"))
(setq poi2 (getpoint poi1 "\nfirst point:"))
(setq select1 (ssget "c" (list (- (car poi1) 0.1) (- (cadr poi1) 0.1)) (list (+ (car poi1) 0.1) (+ (cadr poi1) 0.1))))
(setq ent (entget (ssname select1 0)))
(setq first_point (cdr (assoc 10 ent)))
(setq last_point (cdr (assoc 11 ent)))
(if (and (= (car poi1) (car first_point)) (= (cadr poi1) (cadr first_point)))
(command "line" last_point poi2 "")
(command "line" first_point poi2 "")
)
(command "erase" select1 "")
)
且放白鹿青崖间,须行即骑访名山。
安能摧眉折腰事权贵,使我不得开心颜!
d


所有的时间均为北京时间。 现在的时间是 04:17 PM.