yu960312 发表于 2021-7-17 06:11:04

lisp批量自身旋转,求大神修改

(defun C:ZR ()
(setvar "cmdecho" 0) ;指令执行过程不响应
(princ "\n自身旋转")
(setq ss (ssget))
(repeat (setq i (sslength ss))
(setq i (1- i) a (vlax-ename->vla-object (ssname ss i)))
(vla-getboundingbox a 'minpt 'maxpt)
(mapcar 'set '(minpt maxpt) (mapcar 'vlax-safearray->list (list minpt maxpt)))
(setq p (mapcar '(lambda (x y) (/ (+ x y) 2.0)) minpt maxpt))
(command "_.rotate" ss "" p 90.0)
)
(princ)
)
(目前选择一个对象可以,批量就不行)

yshf 发表于 2021-7-17 08:13:34


(defun C:ZR ()
    (setvar "cmdecho" 0) ;指令执行过程不响应
    (setq osm (getvar "osmode"))
    (setvar "osmode" 0)
    (princ "\n自身旋转")
    (If (setq ss (ssget))
      (repeat (setq i (sslength ss))
            (setq i (1- i))
          (setq ent (ssname ss i))
          (vla-getboundingbox
                 (vlax-ename->vla-object ent)
               'minpt
               'maxpt
          )
            (mapcar 'set '(minpt maxpt) (mapcar 'vlax-safearray->list (list minpt maxpt)))
            (setq p (mapcar '(lambda (x y) (/ (+ x y) 2.0)) minpt maxpt))
            (command "_.rotate" ent "" p 90.0)
         )
   )
   (setvar "osmode" osm)
   (setvar "cmdecho" 1)
   (princ)
)

lee50310 发表于 2021-7-17 08:31:02

本帖最后由 lee50310 于 2021-7-17 08:48 编辑

試試看:


(defun C:ZR ()
(setvar "cmdecho" 0) ;指令执行过程不回应
(princ "\n自身旋转")
(setq ss (ssget))
(setq sel(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(foreach x sel
         (vla-getboundingbox (vlax-ename->vla-object x) 'minpt 'maxpt)
         (mapcar 'set '(minpt maxpt) (mapcar 'vlax-safearray->list (list minpt maxpt)))
         (setq p (mapcar '(lambda (x y) (/ (+ x y) 2.0)) minpt maxpt))
         (command "_.rotate" x "" p 90.0)
);end_forecch
(princ)
)

烟盒迷唇 发表于 2021-7-17 07:17:58

command那句错了，不是SS而是A

Rocky121209 发表于 2021-7-26 11:06:06

刚好我也用到，感谢各位

kkq0305 发表于 2021-7-17 10:44:51

(defun C:ZR ()
(vl-load-com)
(setq ss (ssget))
(setq sel (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(foreach x sel
    (vla-getboundingbox
      (vlax-ename->vla-object x)
      'minpt
      'maxpt
    )
    (mapcar 'set
          '(minpt maxpt)
          (mapcar 'vlax-safearray->list (list minpt maxpt))
    )
    (setq p (mapcar '* '(0.5 0.5) (mapcar '+ minpt maxpt)))
    (vla-Rotate (vlax-ename->vla-object x) (vlax-3D-point p)(* 0.5 pi))
)
(princ)
)

yu960312 发表于 2021-7-17 10:49:52

烟盒迷唇 发表于 2021-7-17 07:17
command那句错了，不是SS而是A

谢谢大佬指点

yu960312 发表于 2021-7-17 10:50:10

yshf 发表于 2021-7-17 08:13
(defun C:ZR ()
    (setvar "cmdecho" 0) ;指令执行过程不响应
    (setq osm (getvar "osmode"))


谢谢大佬指点

yu960312 发表于 2021-7-17 10:51:08

lee50310 发表于 2021-7-17 08:31
試試看:

谢谢,我试试看

yu960312 发表于 2021-7-17 10:51:55

kkq0305 发表于 2021-7-17 10:44
(defun C:ZR ()
(vl-load-com)
(setq ss (ssget))


感谢大神指点
页: [1] 2
查看完整版本: lisp批量自身旋转,求大神修改