TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Brick_top on December 16, 2010, 03:35:26 PM
-
Hi there
I can only get the insertion point.
How can I get a rectangular raster image boundary coordinates?
thanks
-
Look into vla-getboundingbox. You could also add ImageHeight property to the origin y value and the ImageWidth property to the origin X value.
-
Welcome to theSwamp.
This is from the help files on DXF codes
14
Clip boundary vertex (in OCS)
DXF: X value; APP: 2D point (multiple entries)
NOTE 1) For rectangular clip boundary type, two opposite corners must be specified. Default is (-0.5,-0.5), (size.x-0.5, size.y-0.5). 2) For polygonal clip boundary type, three or more vertices must be specified. Polygonal vertices must be listed sequentially
-
Welcome Brick Top
Maybe you can use this
(defun image_coords(/ pt_list)
(setq img_l (acet-ent-geomextents (car(entsel))))
(setq pt1_l (list (car (car img_l)) (cadr (nth 1 img_l))0) pt2_l (nth 1 img_l)pt3_l (list (car (nth 1 img_l)) (nth 1 (car img_l)) 0)pt4_l (car img_l))
(setq pt_list (list pt1_l pt2_l pt3_l pt4_l))
)
But only works with express tools :-(
-
But only works with express tools :-(
Maybe this (http://lee-mac.com/boundingbox.html)?
-
Or this (will not work for clipped images):
(defun c:imgframe (/ e h l o org w x y z)
(and (setq e (car (entsel)))
(= (cdr (assoc 0 (entget e))) "IMAGE")
(setq o (vlax-ename->vla-object e))
(setq w (vla-get-imagewidth o))
(setq h (vla-get-imageheight o))
(setq org (vlax-get o 'origin)
x (car org)
y (cadr org)
z (caddr org)
)
;;list as BL BR UR UL
(setq l (list org (list (+ x w) y z) (list (+ x w) (+ y h) z) (list x (+ y h) z)))
)
l
)
(c:imgframe)
-
This code will get you close. I can't seem to translate the coordinates correctly though. It returns points as if the insert point was 0,0,0, but then it is still off a little. At least it's a start for someone.
(defun GetImageClipBoundry ( ename / Data Ang InsPt Dist 1pixList PtList )
(setq Data (entget ename))
(setq Ang (angle '(0. 0. 0.) (setq InsPt (cdr (assoc 10 Data)))))
(setq Dist (distance InsPt '(0. 0. 0.)))
(setq 1pixList (cdr (assoc 11 (entget (cdr (assoc 340 Data))))))
(foreach i Data
(if (equal (car i) 14) (setq PtList (cons (mapcar (function *) (cdr i) 1pixList) PtList)))
)
)
-
Working from your code, an untested stab in the dark :|
(defun GetImageClipBoundry ( ename / Data 1px )
(setq Data (entget ename))
(setq 1px (cdr (assoc 11 (entget (cdr (assoc 340 Data))))))
(
(lambda ( v )
(mapcar
(function
(lambda ( pair )
(if (= 14 (car pair))
(mapcar '+ (mapcar '* (cdr pair) 1px) v)
)
)
)
(member (assoc 14 data) data)
)
)
(cdr (assoc 10 data))
)
)
-
Hi,
This one seems to work whatever the plane and rotation of the image.
;; RasterCoords
;; Returns the list of a rectangular image raster vertices in WCS coordinates (LL LR UR UL)
(defun RasterCoords (img / elst v1 v2 org)
(setq elst (entget img)
v1 (mapcar '(lambda (x) (* x (cadr (assoc 13 elst)))) (cdr (assoc 11 elst)))
v2 (mapcar '(lambda (x) (* x (caddr (assoc 13 elst)))) (cdr (assoc 12 elst)))
)
(mapcar '(lambda (p) (trans p img 0))
(list
(setq org (cdr (assoc 10 elst)))
(mapcar '+ org v1)
(mapcar '+ org v1 v2)
(mapcar '+ org v2)
)
)
)
-
That will only get you the correct image rectangle Gile. You have to use dxf code 14 for the clipping points. Use the command ' imageclip ' and select a rectangle in the middle of the image, and then run your code.
-
Oh man I'm really sorry to only come back now, honestly I somehow forgot I created this thread.
Anyway thanks for all the replies! I already worked that out
It's incredible how much help I got from all of you
This place is invaluable
-
Welcome Brick Top
Maybe you can use this
(defun image_coords(/ pt_list)
(setq img_l (acet-ent-geomextents (car(entsel))))
(setq pt1_l (list (car (car img_l)) (cadr (nth 1 img_l))0) pt2_l (nth 1 img_l)pt3_l (list (car (nth 1 img_l)) (nth 1 (car img_l)) 0)pt4_l (car img_l))
(setq pt_list (list pt1_l pt2_l pt3_l pt4_l))
)
But only works with express tools :-(
I use other express tools functions - ACET-GEOM-IMAGE-CLIP-LIST
(defun C:RIC (/ img lst:pt lst1 ret)
;;;Restore Image Contour
(vl-load-com)
(if
(and (princ "\nSelect image for restore boundary contour")
(setq img (ssget "_:S:E:L" '((0 . "IMAGE"))))
(setq img (ssname img 0))
)
(progn
(setq lst:pt (ACET-GEOM-IMAGE-CLIP-LIST img))
(setq lst1 (mapcar '(lambda (x) (trans x 1 (ucszdir))) lst:pt))
(if (entmakelwpline
(mapcar '(lambda (x) (list (car x) (cadr x))) lst1)
0
0
(caddr (trans '(0 0 0) 1 (ucszdir)))
(ucszdir)
(cdr (assoc 410 (entget (entlast))))
)
(progn
(setq ret (vlax-ename->vla-object (entlast))
img (vlax-ename->vla-object img)
)
(mapcar
'(lambda (x y) (vlax-put-property ret x y))
'(Linetype LineWeight Color Layer)
(mapcar
'(lambda (x)
(vlax-get-property img x)
)
'(Linetype LineWeight Color Layer)
)
)
(SSSETFIRST nil (ssget "_L"))
)
)
)
)
(princ)
)
;;; UCSZDIR from gile
;;; Returns the normal vector (extrusion direction) of the current UCS XY plane
(defun ucszdir ()(trans '(0 0 1) 1 0 T))
(defun entmakelwpline (plist flag width Elev ucszdir space)
(entmakex
(append
(list
'(0 . "LWPOLYLINE" )
'(100 . "AcDbEntity" )
(cons 8 (getvar "CLAYER"))
'(100 . "AcDbPolyline" )
(if space (cons 410 space)(cons 410 (getvar "CTAB")))
(cons 90 (length plist)) ;Vx number
(cons 70 flag) ;Is Closed
(cons 43 width) ;Width
(cons 38 Elev) ;Elevation
)
(mapcar '(lambda (x) (cons 10 x)) plist)
(list(cons 210 ucszdir))
)
)
)
-
Hi,
This one seems to work with clipped or rectangular raster images (and wipeouts) whatever the construction plane.
Edit: corrected bugs with rectangular clipped and/or rotated and non uniformly scaled images
;; gc:RasterVertices
;; Returns the image raster (or wipeout) boundary vertices list (WCS)
(defun gc:RasterVertices (img / elst ins u v size norm mat disp pts)
(setq elst (entget img)
ins (cdr (assoc 10 elst))
u (cdr (assoc 11 elst))
v (cdr (assoc 12 elst))
size (cdr (assoc 13 elst))
norm (gc:CrossProduct u v)
u (trans u 0 norm)
v (trans v 0 norm)
mat (trp (list u (mapcar '- v) '(0. 0. 1.)))
disp (mapcar '+
(trans ins 0 norm)
(gc:ScaleVector v (cadr size))
(gc:ScaleVector u 0.5)
(gc:ScaleVector v -0.5)
)
pts (if (= 1 (logand 1 (cdr (assoc 71 elst))))
((lambda (l)
(list (car l)
(list (caadr l) (cadar l) (caddar l))
(cadr l)
(list (caar l) (cadadr l) (caddar l))
)
)
(gc:massoc 14 elst)
)
(cdr (gc:massoc 14 elst))
)
)
(mapcar
'(lambda (p)
(trans (mapcar '+ (mxv mat p) disp) norm 0)
)
pts
)
)
;; gc:ScaleVector
;; Multiply a vector by a scalar
(defun gc:ScaleVector (v s) (mapcar (function (lambda (x) (* x s))) v))
;; gc:CrossProduct
;; Returns the cross product of two vectors
(defun gc:CrossProduct (v1 v2)
(list (- (* (cadr v1) (caddr v2)) (* (caddr v1) (cadr v2)))
(- (* (caddr v1) (car v2)) (* (car v1) (caddr v2)))
(- (* (car v1) (cadr v2)) (* (cadr v1) (car v2)))
)
)
;; MXV
;; Apply a transformation matrix to a vector -Vladimir Nesterovsky-
(defun mxv (m v)
(mapcar (function (lambda (r) (apply '+ (mapcar '* r v)))) m)
)
;; TRP
;; Transpose a matrix -Doug Wilson-
(defun trp (m) (apply 'mapcar (cons 'list m)))
;; gc:massoc
;; Returns the list of all values for the code in an association list
(defun gc:massoc (code alst)
(if (setq alst (member (assoc code alst) alst))
(cons (cdar alst) (gc:massoc code (cdr alst)))
)
)
-
I made some corrections to 'gc:RasterVertices'.
The previous code returned the entire image coordinates in case of a rectangular clip and wrong coordinates with rotated non uniformly scaled images.
All seems to work fine now...
-
Indeed, the program is perfect.
A test ...
Always returns the 4 corners with the right way to calculate the proper normal.
Regards.
(http://img255.imageshack.us/img255/9087/gillepiramide.th.jpg) (http://img255.imageshack.us/i/gillepiramide.jpg/)
Regards.