Here is a bit of code that worked in previous versions, and it still
works 2006, but only after I load the code manually instead of in the
compiled VLX.
Anyone know of a solution to this problem? Thanks in advance.
Code listed below...
;;; Program using bpoly routine to draw boundary polyline
;;; 31-October 2005
(defun c:draw_boundary (/ pt poly Obj
mass_prop _area cent_pt TmpObj
i ss_hatch ss_text del_hatch
ss_poly
)
(vl-load-com)
(setq *model*
(vla-get-modelspace
(vla-get-activedocument
(vlax-get-acad-object)
)
)
)
;; Get input
(setq txht (getreal "\nEnter text height <10>: "))
(if (= txht nil)
(setq txht 10.)
) ;_if
;; Get starting number
(setq i (getint "\nEnter starting number for labeling <1>: "))
(if (= i nil)
(setq i 1)
) ;_if
;; Initialize selection sets
(setq ss_hatch (ssadd))
(setq ss_text (ssadd))
(setq ss_poly (ssadd))
;; Select point inisde region
(setq pt (getpoint "\nPick Internal Point... "))
(while (/= pt nil)
(progn
;; Get boundary poly
(setq poly (boundary pt))
;;(setq poly (command "_bpoly" pt))
(if (/= poly nil)
(progn
(setq i (+ i 1))
(setq Obj (vlax-ename->vla-object poly))
(setq mass_prop (VxGetMassProps Obj))
(setq _area (nth 1 mass_prop))
;; Label area and draw centroid
(setq cent_pt (vlax-3d-point (car mass_prop)))
(setq
TmpObj (vla-addText
*model*
(itoa i)
cent_pt
txht
)
)
(setq ss_text (ssadd (entlast) ss_text))
;;(setq TmpObj (vla-AddPoint *model* cent_pt))
;; Bhatch area
(command "_bhatch" "p" "s" "s" poly "" "")
(setq ss_hatch (ssadd (entlast) ss_hatch))
;; Convert polylline to LWPOLYLINE
(command "_convertpoly" "L" poly "")
(setq ss_poly (ssadd poly ss_poly))
) ;_progn
(alert "Closed area not found!")
) ;_if
(setq pt (getpoint "\nPick Internal Point..."))
) ;_progn
) ;_while
;; Delete Hatches???
(initget 0 "Yes No")
(setq
del_hatch (getkword
"\nDelete hatches and text created? [Yes/No] <Yes>: "
)
)
(if (not del_hatch)
(setq del_hatch "Yes")
) ;_if
(if (= del_hatch "Yes")
(command "_erase" ss_text ss_hatch "")
) ;_if
(princ "\nNormal Execution of: draw_boundary!")
(princ)
) ;_defun
(princ "\nNew command: draw_boundary")
(princ)
;; !
****************************************************************************
;; ! VxGetMassProps
;; !
****************************************************************************
;; ! Function: Returns a list of all mass properties of the object.
;; ! Copyright: ©2001 MENZI ENGINEERING GmbH, Switzerland
;; ! Arguments [Typ]:
;; ! Obj = Object [VLA-OBJECT]
;; ! Return [Typ]:
;; ! > Mass properties '(Centroid RadiiOfGyration
PrincipalDirections
;; ! PrincipalMoments MomentOfInertia
ProductOfInertia
;; ! {Area Perimeter} {Volume}) [LIST]
;; ! Notes:
;; ! - VxGetMassProps is designed to handle closed *Polylines,
;; ! Regions and 3dsolids.
;; !- *Polylines and Regions returns 2D-lists in some parameters.
;; !- 2D-objects returns '(. . . . . . Area Perimeter)
;; !- 3D-objects returns '(. . . . . . Volume)
;; !- Use a DocManagerReactor with a 'vlr-documentToBeDestroyed'-event
;; ! to release the Gb:AcO and Gb:AcD objects at the end of a
;; ! AutoCAD session - otherwise AutoCAD maybe crashes...
;; !
****************************************************************************
(defun VxGetMassProps (Obj / DelFlg ResLst)
(setq Gb:AcO (cond (Gb:AcO)
((vlax-get-acad-object))
)
Gb:AcD (cond (Gb:AcD)
((vla-get-ActiveDocument Gb:AcO))
)
)
(if (member (vla-get-ObjectName Obj)
'("AcDb2dPolyline" "AcDbPolyline")
)
(setq DelFlg T
TmpObj (vlax-safearray-get-element
(vlax-variant-value
(vla-AddRegion
(vla-get-ModelSpace Gb:AcD)
(VxListToArray (list Obj) vlax-vbObject)
)
)
0
)
)
(setq TmpObj (vla-copy Obj))
)
(setq ResLst (append
(list
(vlax-get TmpObj "RadiiOfGyration")
(vlax-get TmpObj "ProductOfInertia")
(vlax-get TmpObj "MomentOfInertia")
(vlax-get TmpObj "PrincipalDirections")
(vlax-get TmpObj "PrincipalMoments")
(vlax-get TmpObj "Perimeter")
(vlax-get TmpObj "Area")
(vlax-get TmpObj "Centroid")
)
)
)
(if DelFlg
(vla-delete TmpObj)
)
(reverse ResLst)
)
;; !
****************************************************************************
;; ! VxListToArray
;; !
****************************************************************************
;; ! Function: Converts a list into an array.
;; ! Copyright: ©2000 MENZI ENGINEERING GmbH, Switzerland
;; ! Arguments [Typ]:
;; ! Lst = Standard list [LIST]
;; ! Typ = Datatype [INT]
;; ! Constants:
;; ! - vlax-vbBoolean
;; ! - vlax-vbDecimal *)
;; ! - vlax-vbDouble
;; ! - vlax-vbInteger
;; ! - vlax-vbLong
;; ! - vlax-vbObject
;; ! - vlax-vbSingle
;; ! - vlax-vbString
;; ! - vlax-vbVariant
;; ! Return [Typ]:
;; ! > Array [VARIANT]
;; ! Notes:
;; ! *)Missing datatype in Visual LISP, initialize it in your
Autoloader.
;; ! - Can't be used for dotted pair or nested lists.
;; !
****************************************************************************
(defun VxListToArray (Lst Typ)
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray Typ (cons 0 (1- (length Lst))))
Lst
)
)
)
Sorry... the call to bpoly line above should be:
(setq poly (bpoly pt))
with: (setq poly (command "_bpoly" pt))
I also tried your suggestion; however, the variable "poly" doesn't
contain the newly created entity. I was able to get it to work by
storing the last entity in the database and then after the call to the
"_bpoly" command, test the current last entry to the one stored. If
they are the same, then no new lines were added, but if they are
different, then a new line was created. This isn't a very clean fix
and there may be cases where it doesn't work.
Does anyone know of a way to load the "bpoly" command in the lisp
routine (similar to (vl-load-com)) that I can put at the beginning of
my code to make sure it gets loaded?
Thanks...