TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: mfadzli87 on June 21, 2019, 03:52:35 AM
-
Hi,
anybody can help me to do a lisp that will move a selected lwpolyline as per attached screenshot.
-
perhaps something like this at the command line:
DoIt: MOVE
Select entities to move:
Entities in set: 2
Enter base point [Displacement] <Displacement>:0,0,0
Enter second point <Use base point as displacement>:@100,100,0
What code have you written so far that you need help with ?
-
The end option for me is as per image. Leave distance as 0 for a non action
PLEASE NOTE for the split to work pick each object in order. Using window for ssget may give odd result.
; x-y-split moves objects apart and move in x or y as well
; by AlanH consulting June 2019
; email info@alanh.com.au
(defun xsplit (ss / x I J)
(setq x (atof (nth 0 ans)))
(setq I (sslength ss))
(setq j I)
(repeat I
(command "_move" (ssname ss (setq I (- I 1))) "" (list 0.0 0.0) (list (* j X) 0.0))
(setq j (- j 1))
)
)
(defun ysplit (ss / Y I J)
(setq Y (atof (nth 1 ans)))
(setq I (sslength ss))
(setq j I)
(repeat I
(command "_move" (ssname ss (setq I (- I 1))) "" (list 0.0 0.0) (list 0.0 (* j y)))
(setq j (- j 1))
)
)
(defun chx (ss / xx )
(setq xx (atof (nth 2 ans)))
(command "_move" ss "" (list 0.0 0.0) (list xx 0.0))
)
(defun chy (ss / yy )
(setq yy (atof (nth 3 ans)))
(command "_move" ss "" (list 0.0 0.0) (list 0.0 yy))
)
(defun x-y-split ( / ans ss)
(setq ss (ssget))
(if (not AH:getvalsm)(load "Multi Getvals.lsp"))
(setq ans (AH:getvalsm (list "Non Zero options will move" "Split X" 5 4 "0" "Split Y" 5 4 "0" "Move x" 5 4 "0" "Move y" 5 4 "0")))
(if (/= (nth 0 ans) 0)(xsplit ss))
(if (/= (nth 1 ans) 0)(ysplit ss))
(if (/= (nth 2 ans) 0)(chx ss))
(if (/= (nth 3 ans) 0)(chy ss))
)
(x-y-split)
-
perhaps something like this at the command line:
DoIt: MOVE
Select entities to move:
Entities in set: 2
Enter base point [Displacement] <Displacement>:0,0,0
Enter second point <Use base point as displacement>:@100,100,0
What code have you written so far that you need help with ?
I got this so far. Try to modified but no luck.. :mrgreen:
(defun c:TEST ( / )
(prompt "\nSelect Lines : ")
(setq l_ss (ssget "_X" '((0 . "ARC,CIRCLE,ELLIPSE,LINE,LWPOLYLINE,POLYLINE,SPLINE"))))
(prompt "\nSelect Rectangle : ")
(setq b_ss (ssget '((0 . "lwpolyline"))))
(repeat (setq b_cnt (sslength b_ss))
(setq b_ent (ssname b_ss (setq b_cnt (1- b_cnt)))
obj (vlax-ename->vla-object b_ent)
min_dist 1000000
m_pt nil
)
(progn (vla-GetBoundingBox obj 'p1 'p2)
(setq i_pt (cons (mapcar (function (lambda (a b) (/ (+ a b) 2.)))
(vlax-safearray->list p1)
(vlax-safearray->list p2))
i_pt
)
)
)
(setq i_pt (nth 0 i_pt))
(repeat (setq l_cnt (sslength l_ss))
(setq l_ent (ssname l_ss (setq l_cnt (1- l_cnt)))
c_pt (vlax-curve-getclosestpointto l_ent i_pt)
)
(cond ( (< (setq md (distance i_pt c_pt)) min_dist)
(setq min_dist md
m_pt c_pt
)
)
)
)
(setq m_ang (angle i_pt m_pt)
m_pt (polar i_pt m_ang (- min_dist 100))
)
(vla-move (vlax-ename->vla-object b_ent) (vlax-3d-point i_pt) (vlax-3d-point m_pt))
)
(princ)
)
-
Did you look at what I posted !
-
Did you look at what I posted !
Sorry Mr BIGAL. I will try your code. I am not very good with lisp. Still learn. Thanks for the help.
-
Should the objects inside the rectangles also be moved?
-
Should the objects inside the rectangles also be moved?
If possible more better.. :smitten:
-
What I posted should work with what you want, but it will need to be run 4 times.
Change x-y-split to c:x-y-split in the two locations this way you can type x-y-split to repeat, after 1st go should just be able to press enter to do again. Make sure Multi getvals is in a support path location with the x-y-split lisp.