社区 › 付费开发 › 求高手帮忙实现如下小功能

包哥 发表于 2023-1-24 00:20:09

求高手帮忙实现如下小功能

先通过拾取两角点绘制一个矩形，然后移动光标（注意不是鼠标左键单击，只是移动鼠标改变光标位置），根据十字光标所在位置（pt1）计算离pt1最近的矩形角点（jd1），将pt1和jd1连线

ssyfeng 发表于 2023-1-24 11:13:03

看看是不是这个效果：

liuhe 发表于 2023-1-24 11:39:33

本帖最后由 liuhe 于 2023-1-24 11:53 编辑

(DEFUN C:TT (/ P1 P2 P3 P4 LST LOOP GR CODE PT PX E1)
(SETQ      P1   (GETPOINT "\n矩形第一点")
      P2   (GETCORNER P1 "\n 矩形第二点")
      P3   (LIST (CAR P1) (CADR P2))
      P4   (LIST (CAR P2) (CADR P1))
      LST(LIST P1 P3 P2 P4 P1)
      LOOP T
)
(ENTMAKEX
    (APPEND
      (list '(0 . "LWPOLYLINE")
   '(100 . "AcDbEntity")
   '(100 . "AcDbPolyline")
   (CONS 90 (LENGTH LST))
      )
      (MAPCAR '(LAMBDA (PT) (CONS 10 PT)) LST)
    )
)

(WHILE LOOP
    (SETQ GR   (GRREAD T 15 2)
          CODE (CAR GR)
          PT   (CADR GR)
    )
    (COND
      ((OR (= CODE 3)                        ; 鼠标左击                        
         (= CODE 11)                        ; 鼠标右击
         (= CODE 25)
       )
       (SETQ LOOP NIL)
      )
      ((= CODE 5)                        ; 鼠标移动
       (SETQ PX
            (CAR (VL-SORT
                     LST
                     (FUNCTION (LAMBDA (E1 E2)
                                 (< (DISTANCE E1 PT) (DISTANCE E2 PT))
                               )
                     )
                   )
            )
       )
       (IF E1
         (ENTDEL E1)
       )
       (SETQ
         E1 (ENTMAKEX (LIST '(0 . "LINE") (CONS 10 PT) (CONS 11 PX)))
       )
      )
    )
)
)





给个币呗:handshake

包哥 发表于 2023-1-24 13:21:38

ssyfeng 发表于 2023-1-24 11:13
看看是不是这个效果：

非常感谢，就是这个效果

包哥 发表于 2023-1-24 13:40:55

liuhe 发表于 2023-1-24 11:39
给个币呗

谢谢大佬，这个效果也很好

查看完整版本: 求高手帮忙实现如下小功能