Noob - Selection set problems

jammie · 发表于 2022-7-6 12:31:58

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   (getpoint  Startpoint "\nSecond point of displacement: :"))     )   (create-script     (list"kti_archt_move""p" ;previous selection set""(Pt2str Startpoint)(Pt2str Endpoint))     )   ) )

Lee Mac · 发表于 2022-7-6 12:35:31

Nice idea Jammie, I've seen you use that before - only downside I can see is that the script takes control over the LISP But that may not be a problem in this situation.

bubba74 · 发表于 2022-7-6 12:38:50

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.

copy

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.

wizman · 发表于 2022-7-6 12:43:23

How about:

copy

(sssetfirst   nil   (ssget       '((-4 . "")        )   ) ;_ ssget) ;_ sssetfirst;;;;(kti_archt_move)

copy

(sssetfirst   nil   (ssget       '((0 . "INSERT")(66 . 1))   ) ;_ ssget) ;_ sssetfirst;;;;(command "._move")

wizman · 发表于 2022-7-6 12:45:44

try also to add this to jammie's code, to invoke a lisp transparently:

copy

   (vl-load-com)   (vlax-add-cmd "kti_archt_move" 'kti_archt_move "kti_archt_move" 1)

bubba74 · 发表于 2022-7-6 12:48:30

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.

bubba74 · 发表于 2022-7-6 12:51:43

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.

copy

(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!

alanjt · 发表于 2022-7-6 12:53:59

Just so you know, you can accomplish this with:

copy

(vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) "LINE ")

Lee Mac · 发表于 2022-7-6 12:56:42

This may be more robust for you

copy

(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 }

bubba74 · 发表于 2022-7-6 13:00:20

Sorry, I have no experience with visual lisp. Why does this benefit me?

[编程交流] Noob - Selection set problems

发表回复

精选推荐