(defun c:PT (/ o l pt va di an et xval noc obj1 e)
(setq
pt (getpoint "\nPick the first point:")
xv(car pt) yv(cadr pt)
va (getpoint pt "\nPick the second point:")
et (getdist "\nEnter Thickness:")
an (angtos(angle pt va))
xval (getdist "\nEnter Length (X value):")
sd(getint "\n Enetr Spacer :")
dbc(+ xval sd)
xy(list xv (+(- yv 80)et))
)
(command "ucs" "3" pt va "")
(if (zerop xval)
(progn
(princ "\nError: Length (X value) cannot be zero.")
(exit)
)
)
(setq noc (fix (+ 1(/ di xval))))
(if (< noc 1)
(setq noc 1)
)
(command "ZOOM" "S" pt va)
(command "_.Insert" "D:/IDS/OTHERS/PAT.DWG" pt "" "" 0)
(setq obj1 (entlast))
(setq o (vlax-ename->vla-object obj1))
(setq l (list (cons "X" xval) (cons "Y" et)))
(foreach prop (vlax-safearray->list (vlax-variant-value (vla-getDynamicBlockProperties o)))
(if (setq e (assoc (vla-get-PropertyName prop) l))
(vla-put-value prop (vlax-make-variant (cdr e) 5))
)
)
(command "-ARRAY" obj1 "" "R" "" noc dbc)
(command "ZOOM" "P")
(princ)
)
when i picked two points pt and va i want place all array objects in this points but its place outside of the points pt and va
You're missing calculation of di.
Also think that you should insert your block at '(0 0) coords because you are changing UCS with beginning at pt.
@jaimuthu hi,
here is my version, command ARPAT ![]()
The command starts with looking for pat.dwg block if not found, command stops
than the program needs to know the direction of X axis of the rectangle by specifying two points.
then you specify the opposite corner from the first and this defines the rectangle to fill.
Command: ARPAT
<Specify first point>/Pick:
Pick let you select a line or pline segment to align to (saves you pick 2 points)
if the angle of X direction is none zero, a new ucs is created with the first point as origin.
the space between the blocks is calculated automatically to fill the rectangle equally.
do you want an option to specify the space on X/Y?
enjoy
Moshe
(vl-load-com) ; load activex support
;; Get Dynamic Block Property Value - Lee Mac
;; Returns the value of a Dynamic Block property (if present)
;; blk - [vla] VLA Dynamic Block Reference object
;; prp - [str] Dynamic Block property name (case-insensitive)
(defun LM:getdynpropvalue ( blk prp )
(setq prp (strcase prp))
(vl-some '(lambda ( x ) (if (= prp (strcase (vla-get-propertyname x))) (vlax-get x 'value)))
(vlax-invoke blk 'getdynamicblockproperties)
)
)
(defun c:ArPat (/ select_object ; local function
BNAME t0 t1 t2 p0 p1 p2 fname AcDbBlkRef bx yx xLen yLen rows cols xSpc ySpc)
(defun select_object (/ ask pick prm)
(initget "Pick")
(setq ask (getpoint "\n<Specify first point>/Pick: "))
(cond
((eq (type ask) 'LIST)
(setq t0 ask)
(setq t1 (getpoint t0 "\nSpecify second point: "))
); case
((eq ask "Pick")
(if (and
(setq pick (entsel))
(eq (cdr (assoc '0 (entget (car pick)))) "LINE")
)
(progn
(setq t0 (vlax-curve-getStartPoint (car pick)))
(setq t1 (vlax-curve-getEndPoint (car pick)))
); progn
(progn
(setq prm (vlax-curve-getParamAtPoint (car pick) (osnap (cadr pick) "nea")))
(setq t0 (trans (vlax-curve-getPointAtParam (car pick) (fix prm)) 0 1))
(setq t1 (trans (vlax-curve-getPointAtparam (car pick) (1+ (fix prm))) 0 1))
); progn
); if
); case
); cond
); select_object
(setvar "cmdecho" 0)
(command "._undo" "_begin")
(setq BNAME "pat") ; const
; first look for "pat" block, exit if not found.
(cond
((not (or
(tblsearch "block" BNAME)
(setq fname (findfile (strcat BNAME ".dwg")))
)
); not
(vlr-beep-reaction)
(prompt (strcat "\nBlock \"" (strcase BNAME) " is not found."))
); case
((not (select_object)))
( t
(if (eq (angtos (angle t0 t1) 0 2) "0.00")
(setq p0 t0)
(progn
(command "._ucs" "_3p" t0 t1 (polar t0 (+ (angle t0 t1) (/ pi 2)) (/ (distance t0 t1) 2)))
(command "._plan" "")
(setq p0 '(0.0 0.0 0.0))
); progn
); if
(if (and
(setq p2 (getcorner p0 "\nSpecify other corner: "))
(setq p1 (list (car p2) (cadr p0)))
)
(progn
(command "._insert" "pat" "_None" p0 1 1 0)
(setq AcDbBlkRef (vlax-ename->vla-object (entlast)))
(if (not
(and
(setq bx (LM:getdynpropvalue AcDbBlkRef "X"))
(setq by (LM:getdynpropvalue AcDbBlkRef "Y"))
)
)
(progn
(vlr-beep-reaction)
(print (strcase "\nCan not find X/Y dynamic linear parameters in block \"" (strcase BNAME) "."))
); progn
(progn
(setq xLen (distance p0 p1))
(setq yLen (distance p1 p2))
(cond
((not
(and
(> (setq rows (fix (/ yLen by))) 0)
(> rows 1)
(setq ySpc (/ (rem yLen by) (1- rows)))
)
)
(entdel (entlast))
(vlr-beep-reaction)
(prompt "\nInvalid number of rows.")
); case
((not
(and
(> (setq cols (fix (/ xLen bx))) 0)
(> cols 1)
(setq xSpc (/ (rem xLen bx) (1- cols)))
)
)
(entdel (entlast))
(vlr-beep-reaction)
(prompt "\nInvalid number of columns.")
); case
( t
(command "._array" "si" "_Last" "_Rectangular" rows cols "_None" (+ by ySpc) "None" (+ bx xSpc))
); case
); cond
); progn
); if
(if (not (eq (angtos (angle t0 t1) 0 2) "0.00"))
(progn
; restore ucs
(command "._ucs" "_previous")
(command "._plan" "")
); progn
); if
(vlax-release-object AcDbBlkRef)
); progn
); if
); case
); cond
(command "._undo" "_end")
(setvar "cmdecho" 1)
(princ)
); c:ArPat
Can't find what you're looking for? Ask the community or share your knowledge.