yubihai 发表于 2019-10-7 08:39:16

在2010及以上版本不可用，提示：错误: no function definition: VLAX-CURVE-GETSTARTPOINT

ketxu 发表于 2019-11-1 11:30:50

yubihai 发表于 2019-10-7 08:39
在2010及以上版本不可用，提示：错误: no function definition: VLAX-CURVE-GETSTARTPOINT

Put (vl-load-com) at top or bottom of lisp ^^

1028695446 发表于 2019-11-2 00:25:25

本帖最后由 1028695446 于 2019-11-2 00:27 编辑

ketxu 发表于 2019-11-1 11:30
Put (vl-load-com) at top or bottom of lisp ^^
我把他改成动态的了(vl-load-com)
(defun c:rex ( /ss i e pts ob del-e a aa mouse elast)
(setq pac (getvar 'peditaccept))
(setvar 'peditaccept 1)
;(if (not width) (setq width 1.00))
;(setq width (cond
;            ((getdist(strcat "\nEnter Width <"(rtos width 2 2)">: ")))
;            (width)
;            )
;)
(setq del-e nil)
(if (and
      (setq ss (ssget ":E:S" '((0 . "LWPOLYLINE,LINE"))))
      (setq pt0(getpoint "\n指定第一点:"))
      ;(setq pt0 (cadr(car(cdddar(ssnamex ss 0)))))      
      )
    (progn
      (setq elast(entlast))
      (setq loop T)
      (while loop
      (setq mouse (grread T 12 0))
      (setq a (car mouse) aa (cadr mouse))
      (cond
          ((= a 5)
            (redraw)
            ;(if (= elast(entlast))(princ)(entdel (entlast)))
            (if del-e(entdel del-e)(princ))
            (grdraw pt0 aa 1);画向量
            (setq width(distance pt0 aa))
            (if (> width 0.001)
            (progn
                (setq i 0)
                (repeat (setq i (sslength ss))
                  (setq e (ssname ss (Setq i (1- i))) sss (ssadd))
                  (setq pts (mapcar
                              '(lambda (y)
                                 (list (vlax-curve-getStartPoint y)
                                 (vlax-curve-getEndPoint y)
                                 )
                               )
                              (mapcar 'car
                              (mapcar
                                  '(lambda (x)
                                     (setq ob (vlax-invoke
                                                (vlax-ename->vla-object e)
                                                'Offset
                                                x
                                              )
                                     )
                                     (ssadd (entlast) sss)
                                     ob
                                 )
                                  (list (setq h (* 0.5 width))
                                    (- h)
                                  )
                              )
                              )
                            )
                  )
                  (mapcar '(lambda (k l)
                           (entmakex (list (cons 0 "LINE") (cons 10 k) (cons 11 l)))
                           (ssadd (entlast) sss)
                           )
                  (car pts)(cadr pts)
                  )
                  (command "_.pedit" "_m" sss """_j" 0.0 "")
                  (setq del-e (entlast))
                  ;(entdel e)
                )
            )
            )
          )            ;;; 鼠标移动
          ( (or (= 25 a) (= 11 a) ;右键
            (and (= a 2) (= aa 13));回车
            (and (= a 2) (= aa 32));或空格
            (= a 3);鼠标左键
            )
            (setq loop nil)
          )
      )
      )
    )
)
(redraw)
(setvar 'peditaccept pac)
(princ)
)

346064728 发表于 2021-3-16 23:42:41

错误: no function definition: VLAX-CURVE-GETSTARTPOINT
会出现这个错误

yoyoho 发表于 2021-3-17 16:38:53

谢谢! 1028695446 分享程序!!!!!!

zmzk 发表于 2022-4-24 06:08:08

挺好的，这个我能 用到，谢谢

sunny_8848 发表于 2022-4-26 16:33:11

要是能框选四条首尾连接的直线变成矩形就好了

vladimirputin 发表于 2023-2-13 15:02:54

非常牛逼的代码，谢谢楼主分享啊。

萝卜干 发表于 2023-3-7 09:40:15

谢谢分享，支持

下文没句号。 发表于 2023-3-9 17:58:31

1028695446 发表于 2019-11-2 00:25
我把他改成动态的了

加一个设置数值就更好了
页: 1 [2] 3
查看完整版本: 直线变矩形源码