直线变矩形源码

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)
)

(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
我把他改成动态的了

加一个设置数值就更好了

账号		自动登录	找回密码
密码			注册