(and (setq Pts (acet-ss-drag-move (ssadd blk) Pt1 "\nSpecify Second Point: " t 0)) (not (vla-move (vlax-ename->vla-object blk) (vlax-3D-point Pts) (vlax-3D-point Pt2))) (setq Rot (acet-ss-drag-rotate (ssadd blk) Pt2 "Specify angle: " T 0)) (vla-put-rotation (vlax-ename->vla-object blk) Rot))but didn't get any result. Infact"blk" returned nil. I was hoping to get the last block inserted. Each block is created (composed) and inserted one at a time. That's because 'blk' is the block definition as found in the Document Block table, not the reference object.
I'll post an example in a bit (defun c:BoxObj (/ *error* BENT BLK BOBJ DEL ENT FLOOR I LAY MA MI NNUM NUM OBJLST OFFSET P1 P2 PTS R SPC SS THGT UFLAG)(vl-load-com) ;; Lee Mac~11.02.10 (setq lay "My Boxing Layer" ;; Layer offset 5.;; Offset thgt 2.5 ;; Text Height delt ;; Delete Original Objects )(defun *error* (msg) (and uFlag (vla-EndUndomark *doc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) (setq *doc (cond (*doc) ((vla-get-ActiveDocument (vlax-get-acad-object)))) spc(if (or (eq AcModelSpace (vla-get-ActiveSpace *doc)) (eq :vlax-true (vla-get-MSpace *doc))) (vla-get-ModelSpace *doc) (vla-get-PaperSpace *doc)))(if (setq ss (ssget)) (progn (setq uFlag (not (vla-StartUndoMark *doc))) (or (tblsearch "LAYER" lay) (vla-add (vla-get-Layers *doc) lay)) (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *doc)) (setq Objlst (cons obj Objlst)) (vla-getBoundingbox obj 'Mi 'Ma) (setq pts (cons (vlax-safearray->list Mi) (cons (vlax-safearray->list Ma) pts)))) (vla-delete ss) (setq Mi (apply (function mapcar) (cons 'min pts)) Ma (apply (function mapcar) (cons 'max pts))) (setq Blk (vlax-invoke (vla-get-Blocks *doc) 'Add (list (- (car Mi) offset) (- (cadr Mi) Offset) 0.) "*U")) (vla-copyObjects *doc (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbObject (cons 0(1- (length ObjLst)))) ObjLst)) Blk) (vla-put-closed (vlax-invoke blk 'AddLightWeightPolyline (list (- (car Mi) offset) (- (cadr Mi) Offset) (- (car Mi) offset) (+ (cadr Ma) offset) (+ (car Ma) offset) (+ (cadr Ma) offset) (+ (car Ma) offset) (- (cadr Mi) offset))):vlax-true) (setq num (if (setq i -1 floor 1 ss (ssget "_X" (list (cons 0 "INSERT") (cons 8 lay) (cons 66 1)))) (progn (while (setq ent (ssname ss (setq i (1+ i)))) (if (< floor (setq nNum (atoi (cdr (assoc 1 (entget (entnext ent))))))) (setq floor nNum))) (itoa (1+ floor))) "1")) (vlax-invoke blk 'AddAttribute thgt acAttributeModePreset "num" (list (/ (+ (car Mi) (car Ma)) 2.) (- (cadr Mi) (+ Offset tHgt)) 0.) "num" num) (vla-put-layer (setq bObj (vlax-invoke spc 'InsertBlock (setq p1 (list (- (car Mi)offset) (- (cadr Mi) Offset) 0.)) (vla-get-Name blk) 1. 1. 1. 0.)) lay) (if Del (mapcar (function vla-delete) ObjLst)) (and (setq p2 (acet-ss-drag-move (ssadd (setq bEnt (vlax-vla-object->ename bObj))) p1 "\nSpecify Second Point: " t 0)) (not (vla-move bObj (vlax-3D-point p1) (vlax-3D-point p2))) (setq r(acet-ss-drag-rotate (ssadd bEnt) p2 "\nSpecify Angle: " t 0)) (vla-put-rotation bObj r)) (setq uFlag (vla-EndUndoMark *doc)))) (princ)) Just tried it. Thanks. It works.
You are indeed a luminous being. Thanks Sadhu,
With a Scale option also:
(defun c:BoxObj (/ *error* BENT BLK BOBJ DEL ENT FLOOR I LAY MA MI NNUM NUM OBJLST OFFSET P1 P2 PTS R SPC SS THGT UFLAG)(vl-load-com) ;; Lee Mac~11.02.10 (setq lay "My Boxing Layer" ;; Layer offset 5.;; Offset thgt 2.5 ;; Text Height delt ;; Delete Original Objects )(defun *error* (msg) (and uFlag (vla-EndUndomark *doc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) (setq *doc (cond (*doc) ((vla-get-ActiveDocument (vlax-get-acad-object)))) spc(if (or (eq AcModelSpace (vla-get-ActiveSpace *doc)) (eq :vlax-true (vla-get-MSpace *doc))) (vla-get-ModelSpace *doc) (vla-get-PaperSpace *doc)))(if (setq ss (ssget)) (progn (setq uFlag (not (vla-StartUndoMark *doc))) (or (tblsearch "LAYER" lay) (vla-add (vla-get-Layers *doc) lay)) (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *doc)) (setq Objlst (cons obj Objlst)) (vla-getBoundingbox obj 'Mi 'Ma) (setq pts (cons (vlax-safearray->list Mi) (cons (vlax-safearray->list Ma) pts)))) (vla-delete ss) (setq Mi (apply (function mapcar) (cons 'min pts)) Ma (apply (function mapcar) (cons 'max pts))) (setq Blk (vlax-invoke (vla-get-Blocks *doc) 'Add (list (- (car Mi) offset) (- (cadr Mi) Offset) 0.) "*U")) (vla-copyObjects *doc (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbObject (cons 0(1- (length ObjLst)))) ObjLst)) Blk) (vla-put-closed (vlax-invoke blk 'AddLightWeightPolyline (list (- (car Mi) offset) (- (cadr Mi) Offset) (- (car Mi) offset) (+ (cadr Ma) offset) (+ (car Ma) offset) (+ (cadr Ma) offset) (+ (car Ma) offset) (- (cadr Mi) offset))):vlax-true) (setq num (if (setq i -1 floor 1 ss (ssget "_X" (list (cons 0 "INSERT") (cons 8 lay) (cons 66 1)))) (progn (while (setq ent (ssname ss (setq i (1+ i)))) (if (< floor (setq nNum (atoi (cdr (assoc 1 (entget (entnext ent))))))) (setq floor nNum))) (itoa (1+ floor))) "1")) (vlax-invoke blk 'AddAttribute thgt acAttributeModePreset "num" (list (/ (+ (car Mi) (car Ma)) 2.) (- (cadr Mi) (+ Offset tHgt)) 0.) "num" num) (vla-put-layer (setq bObj (vlax-invoke spc 'InsertBlock (setq p1 (list (- (car Mi)offset) (- (cadr Mi) Offset) 0.)) (vla-get-Name blk) 1. 1. 1. 0.)) lay) (if Del (mapcar (function vla-delete) ObjLst)) (and (setq p2 (acet-ss-drag-move (ssadd (setq bEnt (vlax-vla-object->ename bObj))) p1 "\nSpecify Second Point: " t 0)) (not (vla-move bObj (vlax-3D-point p1) (vlax-3D-point p2))) (setq s(acet-ss-drag-scale(ssadd bEnt) p2 "\nSpecify Scale: " t 0)) (mapcar (function (lambda (prop) (vlax-put-property bObj (read (strcat prop "ScaleFactor")) s))) '("X" "Y" "Z")) (setq r(acet-ss-drag-rotate (ssadd bEnt) p2 "\nSpecify Angle: " t 0)) (vla-put-rotation bObj r)) (setq uFlag (vla-EndUndoMark *doc)))) (princ)) Thanks. This is too good.
Is it possible to put the scale option as the last action ?
Thanks again. Certainly, just swicth the segments of code around
(defun c:BoxObj (/ *error* BENT BLK BOBJ DEL ENT FLOOR I LAY MA MI NNUM NUM OBJLST OFFSET P1 P2 PTS R SPC SS THGT UFLAG)(vl-load-com) ;; Lee Mac~11.02.10 (setq lay "My Boxing Layer" ;; Layer offset 5.;; Offset thgt 2.5 ;; Text Height delt ;; Delete Original Objects )(defun *error* (msg) (and uFlag (vla-EndUndomark *doc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) (setq *doc (cond (*doc) ((vla-get-ActiveDocument (vlax-get-acad-object)))) spc(if (or (eq AcModelSpace (vla-get-ActiveSpace *doc)) (eq :vlax-true (vla-get-MSpace *doc))) (vla-get-ModelSpace *doc) (vla-get-PaperSpace *doc)))(if (setq ss (ssget)) (progn (setq uFlag (not (vla-StartUndoMark *doc))) (or (tblsearch "LAYER" lay) (vla-add (vla-get-Layers *doc) lay)) (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *doc)) (setq Objlst (cons obj Objlst)) (vla-getBoundingbox obj 'Mi 'Ma) (setq pts (cons (vlax-safearray->list Mi) (cons (vlax-safearray->list Ma) pts)))) (vla-delete ss) (setq Mi (apply (function mapcar) (cons 'min pts)) Ma (apply (function mapcar) (cons 'max pts))) (setq Blk (vlax-invoke (vla-get-Blocks *doc) 'Add (list (- (car Mi) offset) (- (cadr Mi) Offset) 0.) "*U")) (vla-copyObjects *doc (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbObject (cons 0(1- (length ObjLst)))) ObjLst)) Blk) (vla-put-closed (vlax-invoke blk 'AddLightWeightPolyline (list (- (car Mi) offset) (- (cadr Mi) Offset) (- (car Mi) offset) (+ (cadr Ma) offset) (+ (car Ma) offset) (+ (cadr Ma) offset) (+ (car Ma) offset) (- (cadr Mi) offset))):vlax-true) (setq num (if (setq i -1 floor 1 ss (ssget "_X" (list (cons 0 "INSERT") (cons 8 lay) (cons 66 1)))) (progn (while (setq ent (ssname ss (setq i (1+ i)))) (if (< floor (setq nNum (atoi (cdr (assoc 1 (entget (entnext ent))))))) (setq floor nNum))) (itoa (1+ floor))) "1")) (vlax-invoke blk 'AddAttribute thgt acAttributeModePreset "num" (list (/ (+ (car Mi) (car Ma)) 2.) (- (cadr Mi) (+ Offset tHgt)) 0.) "num" num) (vla-put-layer (setq bObj (vlax-invoke spc 'InsertBlock (setq p1 (list (- (car Mi)offset) (- (cadr Mi) Offset) 0.)) (vla-get-Name blk) 1. 1. 1. 0.)) lay) (if Del (mapcar (function vla-delete) ObjLst)) (and (setq p2 (acet-ss-drag-move (ssadd (setq bEnt (vlax-vla-object->ename bObj))) p1 "\nSpecify Second Point: " t 0)) (not (vla-move bObj (vlax-3D-point p1) (vlax-3D-point p2))) (setq r(acet-ss-drag-rotate (ssadd bEnt) p2 "\nSpecify Angle: " t 0)) (vla-put-rotation bObj r) (setq s(acet-ss-drag-scale(ssadd bEnt) p2 "\nSpecify Scale: " t 0)) (mapcar (function (lambda (prop) (vlax-put-property bObj (read (strcat prop "ScaleFactor")) s))) '("X" "Y" "Z"))) (setq uFlag (vla-EndUndoMark *doc)))) (princ)) Thanks, Lee.You are great.
(just forgot to post a reply earlier)
页:
1
[2]