autolisp tracking capabilities?

[LSElite]

Hey guys

Im currently writing a program to insert a block of a duct and stretch its length and width properties defined by user input.
this i have achieved however i was wondering if there is anyway of making this process similar to drawing a line.
what i mean by this is defining the first point as a base where it then allows polar snapping around it?

ive attached the block and the lisp routine for reference.

Cheers

[ReachAndre]

Try this one. I also added a variable and a local variable allowing you to to reuse the previous size.

;;=============================================================================================
;; GET-DYNPROPS CREATES AND RETURNS AN ASSOCIATION LIST OF THE PROPERTIES OF A REFERENCE OF A
;; DYNAMIC BLOCK (ASSOCIATED WITH PROPERTYNAME, FOR EACH PROPERTY). RETURNS NIL IF THE BLOCK
;; REFERENCED IS NOT DYNAMIC
(defun get-dynprops (blkins / CONS-X DYNLN DYNPROPARR DYNPROPLST
                     DYNPROPVAR N OUTLST PROPX PROPX-NM)


  (cond ((equal (vla-get-isdynamicblock blkins) ':vlax-false) nil); first condition
        ((vl-catch-all-error-p
           (setq dynpropvar
                  (vl-catch-all-apply
                    'vla-getdynamicblockproperties
                    (list blkins)
                  ); vl-catch-all-apply
           ); setq
         ); vl-catch-all-error-p
         nil
        ); second condition
        (t
         (setq dynproparr (vlax-variant-value dynpropvar)
               dynproplst (vl-catch-all-apply 'vlax-safearray->list (list dynproparr))
               dynln      (cond ((vl-catch-all-error-p dynproplst) 0)
                                (t (length dynproplst))
                          ); cond
               n          0
         ); setq
         (while (< n dynln)
           (setq propx    (nth n dynproplst)
                 propx-nm (vla-get-propertyname propx)
                 cons-x   (cons propx-nm propx)
                 outlst   (append outlst (list cons-x))
                 n        (1+ n)
           ); setq
         ); while
        ); third condition
  ); cond
  outlst
); defun

(defun c:RD ( / BLK BLKPROPS O_RD_WIDTH P1 l1 p2 WIDTHPROP lengthprop)

  (if (not rd_width) (setq rd_width 12))
  (setq o_rd_width rd_width)

  (command "undo" "begin")
  (setq c_layer (getvar "clayer"))
  (command "clayer" "M-N-DUCT")
  (setq p1 (getpoint "\nPick First Point ")
	p2 (getpoint "\nPick Second Point" p1)
	rd_width (getdist (strcat "\nEnter Duct Width<" (rtos o_rd_width) ">:"))
	a1 (*(angle p1 p2) 57.2957795)
	l1 (distance p1 p2)
	); setq
  (if (= rd_width nil) (setq rd_width ord_width))
  
  (command "-insert" "MM_DuctDraw_Straight" p1 "" "" a1)
  (setq blk (vlax-ename->vla-object (ssname (ssget "L") 0))
	blkprops (get-dynprops blk)
	widthprop (cdr (assoc "Width" blkprops))
	lengthprop (cdr (assoc "Duct Length" blkprops))
	); setq
  (vla-put-value lengthprop (vlax-make-variant (* l1 1.0)))
  (vla-put-value widthprop (vlax-make-variant (* rd_width 1.0)))
  (vla-regen (vla-get-activedocument (vlax-get-acad-object)) AcActiveViewport)

  (command "clayer" c_layer)
  (command "undo" "end")
  ); defun

[GHarvey]

Now, that GET-DYNPROPS function looks somewhat familiar...

http://forums.augi.com/showthread.ph...=1#post1205238

[LSElite]

This works awesome mate!
Cheers for the help

[LSElite]

Yeah cheers again for that mate.
Im kicking myself for not signing up to these forums earlier.
I could have saved myself months of pain...
Its hard trying to teach yourself autolisp with no help or training, this forum is making it alot easier.

[aaronic_abacus]

;This autolisp program draws 3d duct lines.

(DEFUN C:CDL2 ()
 (PROMPT "\n*CREATE DUCT LINE 2* ")
 (IF (= DL NIL) (SETQ DL 12))
 (IF (= DW NIL) (SETQ DW 12))
 (IF (= DD NIL) (SETQ DD 12))
 (SETQ DIP NIL)
 (SETQ LP 1)
 (WHILE LP
  (PROMPT "\nEnter duct length [eXit]<")
  (PRINC (RTOS DL))
  (PROMPT ">: ")
  (INITGET "X x")
  (SETQ DLT (GETDIST))
  (IF (AND (/= DLT NIL) (/= DLT "X") (/= DLT "x")) (SETQ DL DLT))
  (IF (OR (= DLT "X") (= DLT "x")) (SETQ LP NIL))
  (IF (AND (/= DLT "X") (/= DLT "x"))
   (PROGN
    (PROMPT "\nEnter duct width<")
    (PRINC (RTOS DW))
    (PROMPT ">: ")
    (SETQ DWT (GETDIST))
    (IF (/= DWT NIL) (SETQ DW DWT))
    (PROMPT "\nEnter duct depth<")
    (PRINC (RTOS DD))
    (PROMPT ">: ")
    (SETQ DDT (GETDIST))
    (IF (/= DDT NIL) (SETQ DD DDT))
    (IF (= PDIP NIL) 
     (SETQ DIP (GETPOINT "\nSpecify insertion point: ")) 
     (PROGN
      (SETQ LP2 1)
      (WHILE LP2
       (PROMPT "\nSpecify insertion point<")
       (PRINC PDIP)
       (PROMPT ">: ")
       (SETQ DIPT (GETPOINT))
       (IF (= DIPT NIL) 
        (PROGN
         (SETQ DIP PDIP)
         (SETQ LP2 NIL)
        );END PROGN
        (PROGN
         (SETQ DIP DIPT)
         (SETQ LP2 NIL)
       ));END PROGN/IF PDIP
      );END LP2
    ));END PROGN/IF PDIP
    (COMMAND "INSERT" "3dductblock" DIP "X" DL DW DD)
    (PROMPT "\nSpecify rotation angle: ")
    (COMMAND PAUSE)
    (SETQ DB (ENTLAST))
    (SETQ DBL (ENTGET DB))
    (SETQ DBR (CDR (ASSOC 50 DBL)))
    (SETQ PDIP (POLAR DIP DBR DL))
  ));END PROGN/IF DL
 );END LP
 (PRINC)
);END CDL2

[ReachAndre]

;This autolisp program draws 3d duct lines.

Nice addition, I didn't think about adding the 3rd dimension.

[ReachAndre]

Now, that GET-DYNPROPS function looks somewhat familiar...

It should look familiar... Also, that was the code he had loaded as an attachment, I figure I would show it as code for everyone's benefit.

[BlackBox]

Try this one. I also added a variable and a local variable allowing you to to reuse the previous size.

;;=============================================================================================
;; GET-DYNPROPS CREATES AND RETURNS AN ASSOCIATION LIST OF THE PROPERTIES OF A REFERENCE OF A
;; DYNAMIC BLOCK (ASSOCIATED WITH PROPERTYNAME, FOR EACH PROPERTY). RETURNS NIL IF THE BLOCK
;; REFERENCED IS NOT DYNAMIC
(defun get-dynprops (blkins / CONS-X DYNLN DYNPROPARR DYNPROPLST
                     DYNPROPVAR N OUTLST PROPX PROPX-NM)


  (cond ((equal (vla-get-isdynamicblock blkins) ':vlax-false) nil); first condition
        ((vl-catch-all-error-p
           (setq dynpropvar
                  (vl-catch-all-apply
                    'vla-getdynamicblockproperties
                    (list blkins)
                  ); vl-catch-all-apply
           ); setq
         ); vl-catch-all-error-p
         nil
        ); second condition
        (t
         (setq dynproparr (vlax-variant-value dynpropvar)
               dynproplst (vl-catch-all-apply 'vlax-safearray->list (list dynproparr))
               dynln      (cond ((vl-catch-all-error-p dynproplst) 0)
                                (t (length dynproplst))
                          ); cond
               n          0
         ); setq
         (while (< n dynln)
           (setq propx    (nth n dynproplst)
                 propx-nm (vla-get-propertyname propx)
                 cons-x   (cons propx-nm propx)
                 outlst   (append outlst (list cons-x))
                 n        (1+ n)
           ); setq
         ); while
        ); third condition
  ); cond
  outlst
); defun

;; <snip>

Now, that GET-DYNPROPS function looks somewhat familiar...

http://forums.augi.com/showthread.ph...=1#post1205238

This works awesome mate!
Cheers for the help

FWIW - Here's a slightly smaller adaptation, with a bit of error checking:

(vl-load-com)

(defun _GetDynBlockProps (block / out)
  ;; Example:
  ;;     (_GetDynBlockProps (vlax-ename->vla-object eName))
  (if (and (= (type block) 'VLA-OBJECT)
           (= :vlax-true (vla-get-isdynamicblock block))
      )
    (foreach oProperty (vlax-invoke block 'getdynamicblockproperties)
      (setq out
             (cons
               (cons (vla-get-propertyname oProperty) oProperty)
               out
             )
      )
    )
  )
  out
)

** Edit - Actually, I made it simpler still.

Its hard trying to teach yourself autolisp with no help or training, this forum is making it alot easier.

That's just the sort of reaction we're hoping for... Learn what you can, and help others when applicable

[irneb]

FWIW - Here's a slightly smaller adaptation, with a bit of error checking:
...
** Edit - Actually, I made it simpler still.

Even slightly simpler than that

(defun IB:GetDBProps (block / props)
  (if (not (vl-catch-all-error-p (setq props (vl-catch-all-apply 'vlax-invoke (list block 'GetDynamicBlockProperties)))))
    (mapcar '(lambda (obj) (cons (vla-get-PropertyName obj) obj)) props)))

Edit: And if you want to throw away the error checking:

(defun IB:GetDBProps-F (block)
  (mapcar '(lambda (obj) (cons (vla-get-PropertyName obj) obj))
	  (vlax-invoke block 'GetDynamicBlockProperties)))