Thanks
Try the following as a starting point
;|Create an run a script file (create-script (list "tcircle" "l" "" "0.3" "r" ""))|;(defun create-script () (vl-load-com) (setq fname (vl-filename-mktemp "test.scr")file(open fname "w")) (foreach n (write-line n file) ) (close file) (command "script" fname) (vl-file-delete fname) );|Convert an point to a string for exporting to a script fileeg(Pt2str '(10 20 0)) -> 10.000,20.000,0|;(defun Pt2str ( /x y z ) (setq X(rtos (car ) 2 15)Y(rtos (cadr ) 2 15)Z(rtos(caddr )2 15) )(strcat x "," y "," z) )(defun c:test () (setq SelMain(ssget))(setq SelMainSize(sslength SelMain))(setq SelBlock(ssadd))(setq SelNoblock(ssadd))(setq ctr 0)(while (< ctr (sslength SelMain)) (setq Ent(ssname SelMain ctr)) (setq EntData(entget Ent)) (if (assoc 66 EntData) (setq SelBlock(ssadd Ent SelBlock)) (setq SelNoblock(ssadd Ent SelNoblock)) ) (setq ctr(+ ctr 1)))(sssetfirst nil SelNoblock) (if (and (setq Startpoint (getpoint "\nBase point :")) (setq Endpoint (getpointStartpoint "\nSecond point of displacement: :")) ) (create-script (list"kti_archt_move""p" ;previous selection set""(Pt2str Startpoint)(Pt2str Endpoint)) ) ) ) Nice idea Jammie, I've seen you use that before - only downside I can see is that the script takes control over the LISPBut that may not be a problem in this situation. HI Jammie and thanks for the start.
I inputted your code and it seemed to crap out when the script was executed.This is what it looked like.
Command: testSelect objects: Specify opposite corner: 6 foundSelect objects:Base point :Second point of displacement: :nilCommand: kti_archt_moveThis command may not be invoked transparently.Command:Command: pUnknown command "P".Press F1 for help. How about:
(sssetfirst nil (ssget '((-4 . "") ) ) ;_ ssget) ;_ sssetfirst;;;;(kti_archt_move)
(sssetfirst nil (ssget '((0 . "INSERT")(66 . 1)) ) ;_ ssget) ;_ sssetfirst;;;;(command "._move") try also to add this to jammie's code, to invoke a lisp transparently:
(vl-load-com) (vlax-add-cmd "kti_archt_move" 'kti_archt_move "kti_archt_move" 1) Well I'm off for the weekend.I wanted to thank you guys for the help.I believe I have a solution.I'll post it next week when I have more time to test it. I have got my move routine to work great.I didn't have to use scrips at all.All of your comments really helped me to see the solution.Here's the code if you're curious.
(setq SelMain(ssget))(setq SelBlock(ssadd))(setq SelNoblock(ssadd))(setq ctr 0)(while (< ctr (sslength SelMain)) (setq Ent(ssname SelMain ctr)) (setq EntData(entget Ent)) (if (assoc 66 EntData) (setq SelBlock(ssadd Ent SelBlock)) (setq SelNoblock(ssadd Ent SelNoblock)) ) (setq ctr(+ ctr 1)))(if (/= (sslength SelNoBlock) 0) (progn (setq TrackerPointData (entmake '((0 . "POINT")(8 . "TRACKER")(10 0.0 0.0 0.0)))) (setq TrackerPoint (entlast)) (setq pnt1 (cdr(assoc 10 TrackerPointData))) (setq SelNoblock(ssadd TrackerPoint SelNoblock)) (sssetfirst nil SelNoblock) (c:kti_archt_move) (setq TrackerPointData (entget TrackerPoint)) (setq pnt2 (cdr(assoc 10 TrackerPointData))) (entdel TrackerPoint) (command "_.purge" "LA" "TRACKER" "N") (if (/= (sslength SelBlock) 0) (command "._move" SelBlock "" pnt1 pnt2) ) ) (progn (sssetfirst nil SelBlock) (command "._move" "p" "") ))
I basically create a temporary point to extract location info to move the block objects.
Now I will tweak the code for my copy routine.Thanks guys! Just so you know, you can accomplish this with:
(vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) "LINE ")
This may be more robust for you
(defun c:test (/ v-move i ss selBlock SelnoBlock ent trck ) (defun v-move (ss p1 p2 / i ent) (vl-load-com) (setq i -1) (while (setq ent (ssname ss (setq i (1+ i)))) (vla-move (vlax-ename->vla-object ent) (vlax-3D-point p1) (vlax-3D-point p2))) ss) (if (setq i -1 ss (ssget "_:L")) (progn (setq SelBlock (ssadd) SelNoblock (ssadd)) (while (setq ent (ssname ss (setq i (1+ i)))) (if (assoc 66 (entget ent)) (ssadd ent selblock) (ssadd ent selnoblock))) (if (not (zerop (sslength selnoblock))) (progn (setq trck (entmakex '((0 . "POINT") (10 0 0 0)))) (sssetfirst nil selnoblock) (c:kti_archt_move) (if (not (zerop (sslength selblock))) (v-move selblock '(0 0 0) (cdr (assoc 10 (entget trck))))) (entdel trck)) (command "_.move" selblock "" pause pause)))) (princ))
{ untested } Sorry, I have no experience with visual lisp.Why does this benefit me?
页:
1
[2]