Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Array object outside error

2 REPLIES 2
Reply
Message 1 of 3
jaimuthu
120 Views, 2 Replies

Array object outside error

 

 

 

 

(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  

Tags (1)
2 REPLIES 2
Message 2 of 3
ВeekeeCZ
in reply to: jaimuthu

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.

Message 3 of 3
Moshe-A
in reply to: jaimuthu

@jaimuthu  hi,

 

here is my version, command ARPAT :grinning_face:

 

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.

Post to forums  

AutoCAD Inside the Factory


Autodesk Design & Make Report