各位大神看下,求 输入TT 提示框选图纸，框选后右键确认后，提示点击插入点，点击确...

664571221

求 输入TT 提示框选图纸，框选后右键确认后，提示点击插入点，点击确人后吧图纸移动到0,0点

664571221

(defun c:tt (/ b c doc lays p p0)
        (princ "\n选择对象")
        (if (and (ssget)
                                (setq p (getpoint "\n点取基点:"))
                                (setq p (vlax-3D-point p))
                                (setq p0 (vlax-3D-point 0 0 0))
                        )
                (progn
                        (setq doc (vla-get-ActiveDocument(vlax-get-acad-object)))
                        (setq lays (vla-get-Layers doc))
                        (vlax-for a (vla-get-activeselectionset doc)
                                (setq b (vla-Item lays (vla-get-Layer a)))
                                (setq c (vla-get-Lock b))
                                (vla-put-Lock b :vlax-false)
                                (vla-Move a p p0)
                                (vla-put-Lock b c)
                        )
                )               
        )
)波总代码

xyp1964

(defun c:tt ()
  (princ "\n选择对象: ")
  (if (and (setq ss (ssget))(setq p0 (getpoint "\n移动基点: ")))
    (command "move" ss "" "non" p0 "non" '(0 0))
  )
  (princ)
)

664571221

xyp1964 发表于 2023-10-28 16:20
(defun c:tt ()
  (princ "\n选择对象: ")
  (if (and (setq ss (ssget))(setq p0 (getpoint "\n移动基点 ...

(defun c:tt (/ p s ss)
        (princ "\n选择对象")
        (if (and (setq s (ssget))
                                (setq p (getpoint "\n点取基点:"))
                        )
                (progn
                        (vlax-for a (vla-get-Layers (vla-get-ActiveDocument(vlax-get-acad-object)))
                                (setq ss (cons (list a (vla-get-Lock a)) ss))
                        )
                        (foreach x ss (vla-put-Lock (car x) :vlax-false))
                        (command "MOVE" s "" "non" p "non" '(0 0))
                        (foreach x ss (apply 'vla-put-Lock x))
                )               
        )
)



(defun c:tt (/ b c doc lays p p0)
        (princ "\n选择对象")
        (if (and (ssget)
                                (setq p (getpoint "\n点取基点:"))
                                (setq p (vlax-3D-point p))
                                (setq p0 (vlax-3D-point 0 0 0))
                        )
                (progn
                        (setq doc (vla-get-ActiveDocument(vlax-get-acad-object)))
                        (setq lays (vla-get-Layers doc))
                        (vlax-for a (vla-get-activeselectionset doc)
                                (setq b (vla-Item lays (vla-get-Layer a)))
                                (setq c (vla-get-Lock b))
                                (vla-put-Lock b :vlax-false)
                                (vla-Move a p p0)
                                (vla-put-Lock b c)
                        )
                )               
        )
)


(defun c:tt (/ b c doc lays p p0)
        (princ "\n选择对象")
        (if (and (ssget)
                                (setq p (getpoint "\n点取基点:"))
                                (setq p (vlax-3D-point p))
                                (setq p0 (vlax-3D-point 0 0 0))
                        )
                (progn
                        (setq doc (vla-get-ActiveDocument(vlax-get-acad-object)))
                        (setq lays (vla-get-Layers doc))
                        (vlax-for a (vla-get-activeselectionset doc)
                                (setq b (vla-Item lays (vla-get-Layer a)))
                                (setq c (vla-get-Lock b))
                                (if (= :vlax-false c)
                                        (vla-Move a p p0)
                                        (progn
                                                (vla-put-Lock b :vlax-false)
                                                (vla-Move a p p0)
                                                (vla-put-Lock b c)
                                        )
                                )                               
                        )
                )               
        )
)

664571221

xyp1964 发表于 2023-10-28 16:20
(defun c:tt ()
  (princ "\n选择对象: ")
  (if (and (setq ss (ssget))(setq p0 (getpoint "\n移动基点 ...

谢谢派大....