PDA

View Full Version : xclip place then rotate


parkerfeldman
2009-04-16, 04:46 PM
hello i wrote a routine to xclip a file at 40' increments and then it will either place the xclips below the original xref or let you place each xclip individually that part worked fine. now i am trying to add a rotate into it. i would like it to let me place the xclip and then rotate it. here is my code which is not working. i tried using a vla-put to change the rotation property the only problem with that is i need it to rotate around my new point, not the xrefs insertion point.
(defun c:MXC (/ opt)
(setvar "CMDECHO" 0)
(setq osm (getvar "osmode")) ;store osnap settings
(setq ref (car (entsel)))
(setq refobj (vlax-ename->vla-object ref))
(setq inspt (vla-get-InsertionPoint refobj))
(setq ipt (vlax-safearray->list
(vlax-variant-value inspt)
)
)
(setq inptx (car ipt)
inpty (cadr ipt)
)
(setq nx (- inptx 48)) ;set bottom left corner x
(setq ny (- inpty 63)) ;set bottom left corner y
(terpri)
(setq spn (getint "Start at Panel:"))
(setq epn (getint "End at Panel:"))
(setq totp (- epn spn)) ;total panels to be clipped = repeat value
(if (> spn 99)
(setq spn (- spn 99))
)
(setq addx (- (* 480 spn) 480))
(setq nx (+ nx addx)) ;add panel to start at into x
(setq xy1 (cons nx (list ny)))
(setq xy2 (cons (+ nx 480) (list (+ ny 300))))
;(command "rectangle" xy1 xy2)
(initget "All-Below Individually A I")
(setq
opt (getkword "\nPlace Xclips: [All-Below/Individually]: ")

)
(if (or (= opt "Individually") (= opt "I"))
(place)
(clip)
)
(setvar "osmode" osm) ;restore osnap settings
) ;_end multi XClip

(defun clip ()
(command "copy" ref "" "0,0" "0,0")
(command "xclip" ref "" "" "" xy1 xy2)
(repeat totp
(setq x (+ (car xy1) 480))
(setq x2 (+ (car xy2) 480))
(setq xy1 (subst x (car xy1) xy1))
(setq xy2 (subst x2 (car xy2) xy2))
;(command "rectangle" xy1 xy2)
(command "copy" ref "" "0,0" "0,-480")
(command "xclip" ref "" "" "" "" xy1 xy2)
) ;_end repeat
(command "move" ref "" "0,0" "0,-480")
(princ)
) ;_end clip

(defun place ()
(command "copy" ref "" "0,0" "0,0")
(command "xclip" ref "" "" "" xy1 xy2)
(setq nipt ipt)
(setq ix (car nipt))
(setq nix (- ix 480))
(setq nipt (subst nix ix nipt))
(repeat totp
(setq ix (car nipt))
(setq nix (+ ix 480))
(setq nipt (subst nix ix nipt))
(setq x (+ (car xy1) 480))
(setq x2 (+ (car xy2) 480))
(setq xy1 (subst x (car xy1) xy1))
(setq xy2 (subst x2 (car xy2) xy2))
;(command "rectangle" xy1 xy2)
(setq npoint (getpoint "Place Xclip:"))
(command "copy" ref "" nipt npoint)
(setq dist 2.5
p1 (polar npoint 0 dist)
p2 (polar npoint pi dist)
i (- 1)
) ;_ end of setq
(setq ss1 (ssget "C" p1 p2 (list (cons 0 "INSERT"))))
(repeat (sslength ss1)
(setq rref (vlax-ename->vla-object (ssname ss1 (setq i (1+ i)))))
(setq refname (vla-get-name rref))
(if (= (substr refname 1 9) "APT_Level")
(progn
;(setq NewAng (getint "Specify Rotation:"))
(command "rotate" rref npoint (getpoint "Specify Rotation:"))
) ;_end progn
) ;_end if
) ;_end repeat
(command "xclip" ref "" "" "" "" xy1 xy2)
) ;_end repeat
(setq ix (car nipt))
(setq nix (+ ix 480))
(setq nipt (subst nix ix nipt))
(setq npoint (getpoint "Place Xclip:"))
(command "move" ref "" nipt npoint)
(princ)
) ;_end place