(defun C:test
( / _PickEnt
*error* dcl des dch dcf L
)
); defun *error*
(
(
; ( (not (member '(0 . "LWPOLYLINE") (setq enx (entget e)))) )
(
; (setq r (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) enx)))
; (if (= 1 (logand 1 (cdr (assoc 70 enx)))) (setq r (cons (last r) r)))
(setq r
(LM:Entity
->PointList e
)) )
); cond
); while
); lambda
); setq _PickEnt
)
); setq L
); not
)
(
'("test : dialog"
"{ label = \"Display Something\"; spacer;"
" : column "
" {"
" : image "
" { key = \"img\"; height = 16.0; width = 48.0; "
" fixed_width = true; fixed_height = true;"
" horizontal_margin = none; vertical_margin = none;"
" alignment = centered; color = -15;"
" }"
" : button { label = \"Select >>\"; key = \"b\"; alignment = centered; fixed_width = true; }"
" }"
" spacer; ok_only;"
"}"
); list
); mapcar
); and
); not
(prompt "\nUnable to write or load the DCL file.") )
(
(cond ; Inside the dialog (T
; (
; (lambda ( scf c bbox xL / sc x1 y1 x2 y2 sx sy ) ; First obtain the image's size
; (setq sx (dimx_tile "img"))
; (setq sy (dimy_tile "img"))
; (setq sc (* scf (/ (distance (list sx 0.) (list 0. sy)) (apply 'distance bbox))))
; (start_image "img")
; (while xL ; (while) approach, to step thru every 2 elements of the list
; (and
; (vl-every 'set '(x1 y1) (mapcar '- c (car xL))) ; first point - translated from the centroid
; (vl-every 'set '(x2 y2) (mapcar '- c (cadr xL))) ; second point - translated from the centroid
; (mapcar 'set '(x1 y1 x2 y2) (mapcar '(lambda (xx) (* xx sc)) (list x1 y1 x2 y2))) ; use the scale factor to rescale the vector's size
; (apply 'vector_image ; (vector_image x1 y1 x2 y2 color)
; (mapcar 'fix ; fix is required for the (vector_image) function
; (list ; translate the pixelated coordinates so all vectors would be centered
; (+ (/ sx 2.0) (- x1)) ; x-coords must be reversed, else the image seems to be mirrored
; (+ (/ sy 2.0) y1)
; (+ (/ sx 2.0) (- x2)) ; x-coords must be reversed, else the image seems to be mirrored
; (+ (/ sy 2.0) y2)
; 15 ; colour
; ); list
; ); mapcar 'fix
; ); apply 'vector_image
; ); and
; (setq xL (cdr xL))
; ); while
; (end_image) ; Result is as expected, but some extra line appears
; ); lambda
; 0.8 ; scale factor, units to pixels - How do I scale up to the image's limits?
; (car L) ; centroid
; (cadr L) ; bbox
; (caddr L) ; point list
; )
(
(lambda ( scf c bbox xL
/ sc x1 y1 x2 y2 sx sy
) ; First obtain the image's size (setq sc
(* scf
(abs (apply '
max (mapcar '
/ (list sx sy
) (apply '
mapcar (cons '
- bbox
))))))) ; _$ (mapcar '- '(3 2 1) '(1 2 3)) -> (2 0 -2) ; _$ (apply 'mapcar (cons '- '((3 2 1) (1 2 3)))) -> (2 0 -2) ; (setq sc (* scf (/ (distance (list sx 0.) (list 0. sy)) (apply 'distance bbox)))) ; scale by diagonal - incorrect
(while xL
; (while) approach, to step thru every 2 elements of the list (mapcar '
fix ; fix is required for the (vector_image) function (list ; translate the pixelated coordinates so all vectors would be centered (+ (/ sx 2.0) (- x1)) ; x-coords must be reversed, else the image seems to be mirrored
(+ (/ sy 2.0) y1)
(+ (/ sx 2.0) (- x2)) ; x-coords must be reversed, else the image seems to be mirrored
(+ (/ sy 2.0) y2)
15 ; colour
); list
); mapcar 'fix
); apply 'vector_image
); and
); while
(end_image) ; Result is as expected, but some extra line appears ); lambda
0.8 ; scale factor, units to pixels - How do I scale up to the image's limits?
)
; (alert (apply 'strcat (mapcar '(lambda (x) (strcat "\n" (vl-prin1-to-string x))) (caddr L))))
); T
); cond ; Inside the dialog
(cond ; Outside the dialog - Its hidden ); cond ; Outside the dialog - Its hidden
); while
(/= 1 dcf)
); progn
(prompt "\nUser cancelled or terminated the dialog.") )
(T
; < Proceed with the outputs >
); T
); cond
); defun
;;----------------=={ Entity to Point List }==----------------;;
;; ;;
;; Returns a list of points describing or approximating the ;;
;; supplied entity, else nil if the entity is not supported. ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; ent - Entity for which to return Point List. ;;
;;------------------------------------------------------------;;
;; Returns: List of Points describing/approximating entity ;;
;;------------------------------------------------------------;;
(defun LM:Entity
->PointList
( ent
/ der di1 di2 di3 elst fun inc lst par rad
) )
)
inc
(/ di2
(1+ (fix (* 35.0 (/ di2
(cdr (assoc 40 elst
)) (+ pi pi
)))))) )
di1 (+ di1 inc)
)
)
lst
)
)
(if (equal der '
(0.0 0.0 0.0) 1e
-8
) )
(setq inc
(/ (- di2 di1
) (1+ (fix (* 35.0 (/ (- di2 di1
) rad
(+ pi pi
))))))) di1 (+ di1 inc)
)
)
)
)
)
)
)
lst
)
)
)
di1
(+ di1
(/ di3
(1+ (fix (/ 35.0 (/ di3 der
(+ pi pi
))))))) )
)
lst
)
)
inc (/ di2 25.0)
)
di1
(+ di1
(if (equal 0.0 der 1e
-10
) inc
(min inc
(/ 1.0 der
(* 10. inc
))))) )
)
lst
)
)
)
)