Message 1 of 5
Scale extracted map
Not applicable
08-05-2021
11:37 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
What I am looking for is a way to use the corners of the rectangle to scale all the enclosed information down to a fixed length of 300 units by 300 units. Also if you know of a command that could merge offsets into one line I am interested in implementing that type of coding at a later time
I have been working on a function today that extracts the street and land information from a GIS DWG packet and strips it to the origin and puts a box around it. If someone wouldn't mind, I could use assistance in scaling down the sizing.
The current framework is below.
(command
;REMOVAL SECTION
"_.Erase"
(ssget "_X" '((-4 . "<NOT")(8 . "MAP-LAND-RW,MAP-LAND-STREETNAMES")(-4 . "NOT>"))); find all
""
)
(defun c:0 ()
(command "zoom" "E")
(setq xy (getvar "extmin"))
(command "move" "all" "" xy "0,0,0")
(command "zoom" "E")
(command "POINT" "0,0,0")
(command "PDMODE" "34")
(command "PDSIZE" "12")
(princ)
)
(c:0)
(defun c:SREF (/ ss pt1 pt2)
(setvar "cmdecho" 0)
(setq pt1 "0,0,0")
(setq pt2 "0,0,0")
;; (setq lay "MAP-LAND-RW")
(setq ss (ssget "_A" '((8 . "MAP-LAND-STREETNAMES"))))
(command "_.-copytolayer" ss "" "VICINITY-MAP" "D" pt2)
(setq ss (ssget "_A" '((8 . "MAP-LAND-RW"))))
(command "_.-copytolayer" ss "" "VICINITY-MAP" "D" pt2)
(princ)
)
(c:SREF)
;; CREATED BY LEE MAC::
(defun c:yay ( / box obj sel spc *error*)
(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object))) ; reference current document
(vla-StartUndoMark doc) ; start undo mark
;| BEGIN SUBFUNCTIONS |;
; Error Handler
(defun *error* ( msg )
(if osm (setvar 'osmode osm))
(if (not (member msg '("Function cancelled" "quit / exit abort")))
(princ (strcat "\nError: " msg))
)
(princ)
)
;; Selection Set Bounding Box - Lee Mac
;; Returns a list of the lower-left and upper-right WCS coordinates of a
;; rectangular frame bounding all objects in a supplied selection set.
;; sel - [sel] Selection set for which to return bounding box
(defun LM:ssboundingbox ( sel / idx llp ls1 ls2 obj urp )
(repeat (setq idx (sslength sel))
(setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
(if (and (vlax-method-applicable-p obj 'getboundingbox)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
)
(setq ls1 (cons (vlax-safearray->list llp) ls1)
ls2 (cons (vlax-safearray->list urp) ls2)
)
)
)
(if (and ls1 ls2)
(mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))
)
)
;| END SUBFUNCTIONS |;
;| BEGIN MAIN ROUTINE |;
(if (and (setq sel
(ssget "_X" '())
)
(setq box (LM:ssboundingbox sel))
)
(progn
(setq spc
(vlax-get-property (vla-get-activedocument (vlax-get-acad-object))
(if (= 1 (getvar 'cvport))
'paperspace
'modelspace
)
)
)
(if (equal 0.0 (apply '- (mapcar 'caddr box)) 1e-6)
(progn
(setq obj
(vlax-invoke spc 'addlightweightpolyline
(apply 'append
(mapcar '(lambda ( x ) (mapcar '(lambda ( y ) ((eval y) box)) x))
'(
(caar cadar)
(caadr cadar)
(caadr cadadr)
(caar cadadr)
)
)
)
)
)
(vla-put-closed obj :vlax-true)
(vla-put-elevation obj (caddar box))
)
(apply 'vlax-invoke
(vl-list* spc 'addbox
(apply 'mapcar (cons '(lambda ( a b ) (/ (+ a b) 2.0)) box))
(apply 'mapcar (cons '- (reverse box)))
)
)
)
)
)
(princ)
;| END MAIN ROUTINE |;
(vla-EndUndoMark doc) ; end undo mark
(princ)
)
(c:yay)
