Topic: VLA Objects

[cmwade77]

Ok, I am having a mental block, I know that to convert objects to VLA objects you use vlax-ename->vla-object, but what about the other way around?

I have objects that are VLA objects (generated by Lee's Double Offset code), what I need to do is find the ends of the new line/pline drawn, draw a pline, join all three lines and close the new pline.

[BlackBox]

Ok, I am having a mental block, I know that to convert objects to VLA objects you use vlax-ename->vla-object, but what about the other way around?

Example:

Code: [Select]

(setq eName (vlax-vla-object->ename <Object>))


I have objects that are VLA objects (generated by Lee's Double Offset code), what I need to do is find the ends of the new line/pline drawn, draw a pline, join all three lines and close the new pline.

The vlax-curve* functions wil work with both eName and Vla-Objects, although the eName support is not documented very well (if at all?).

(^^ Thanks to Alan for showing me this lil' nuggit of info  ^^)

HTH

[cmwade77]

Ok, I am having a mental block, I know that to convert objects to VLA objects you use vlax-ename->vla-object, but what about the other way around?

Example:

Code: [Select]

(setq eName (vlax-vla-object->ename <Object>))


I have objects that are VLA objects (generated by Lee's Double Offset code), what I need to do is find the ends of the new line/pline drawn, draw a pline, join all three lines and close the new pline.

The vlax-curve* functions wil work with both eName and Vla-Objects, although the eName support is not documented very well (if at all?).

(^^ Thanks to Alan for showing me this lil' nuggit of info  ^^)

HTH

Thank you and Alan for those nuggets. Now, is it possible to join polylines using VLA? That would save me a considerable amount of trouble. I know I can close Plines with it.

[Lee Mac]

The vlax-curve* functions wil work with both eName and Vla-Objects, although the eName support is not documented very well (if at all?).

And you'll be pleasantly surprised at how much faster they operate with Entities over VLA-Objects...

On a 10-sided polygon (LWPolyline) centered at the origin, radius 1:

Code: [Select]

Elapsed milliseconds / relative speed for 32768 iteration(s):

    (vlax-curve-getPointAtDist ENT 4.0).....1248 / 1.54 <fastest>
    (vlax-curve-getPointAtDist OBJ 4.0).....1918 / 1 <slowest>
 

[Lee Mac]

Now, is it possible to join polylines using VLA?

Not a direct method, you would need to recreate/modify the LWPolyline using the point data from all those you want to join.

[cmwade77]

Ok, so I have code that is somewhat working, basically, I am trying to find a way to quickly add hatching for items that are being demolished. I had a routine that kind of worked, I now have a routine that works better. I am still getting some errors with this routine when I select both Polyline and non polyline objects and I am not sure why, it also errors out before the end undo mark gets set. Here is the code in case anyone has any ideas:

Code: [Select]

(defun c:FD (/ *thisdrawing* *ACAD_LAYERS* SS Ct Obj ObjName ObjLayer ObjData OffsetList Obj1Ent Obj2Ent Obj1End Obj2End OldPeditAccept Obj3Ent ODist Scale Obj3 NewLayer SelectionLength)
(vl-load-com)
;Supporting Functions
;;;Function: Get BuondingBox
;;;arg :
;;;      ss -- Select set or a Ename
;;;   onseg -- T or NIL , if T then returns the box in UCS , if NIL in WCS
;;;Support in UCS
;;;Written by Highflybird
;;;Edited by GSLS(SS), 2011-02-16
(defun draw-pl (lst)
  (entmake
(append
  '((0 . "LWPOLYLINE")
(100 . "AcDbEntity")
(100 . "AcDbPolyline")
   )
  (list (cons 90 (length (car lst))))
  (mapcar (function (lambda (x) (cons 10 x))) (car lst))
  (list (cons 70 1))
  (cdr lst)
)
  )
)
(defun ss-get-boundingbox (ss   onseg / Wmat   Umat   i
   ent   obj minPt maxPt  minLs  maxLs
   maxX   maxY minX minY pts
  )
  (if ss
(progn
  (if (eq (type ss) 'ENAME)
(setq ss (ssadd ss (ssadd)))
  )
  (if (and onseg (= (getvar "WORLDUCS") 0))
(setq Wmat (gc:TMatrixFromTo 1 0)
  Umat (gc:TMatrixFromTo 0 1)
);_Use gile's nice function
  )
  (setq i 0)
  (setq minPt (vlax-make-safearray vlax-vbdouble '(0 . 2)))
  (setq maxPt (vlax-make-safearray vlax-vbdouble '(0 . 2)))
  (repeat (sslength ss)
(setq ent (ssname ss i)
  obj (vlax-ename->vla-object ent)
)
(if Wmat
  (vla-TransformBy obj (vlax-tmatrix Wmat))
)
(vla-GetBoundingBox obj 'minpt 'maxpt)
(setq minPt (vlax-safearray->list minPt)
  maxPt (vlax-safearray->list maxPt)
  minLs (cons minPt minLs)
  maxLs (cons maxPt maxLs)
)
(if Umat
  (vla-TransformBy obj (vlax-tmatrix Umat))
)
(setq i (1+ i))
  )
;_Is there better way to get the other coner points , if it's in 3D UCS ?
;_Perhaps it'n use 'trans' function ...
  (setq minX (apply 'min (mapcar 'car minLs)))
  (setq minY (apply 'min (mapcar 'cadr minLs)))
  (setq maxX (apply 'max (mapcar 'car maxLs)))
  (setq maxY (apply 'max (mapcar 'cadr maxLs)))
  (setq pts (list (list minX minY 0)
  (list maxX minY 0)
  (list maxX maxY 0)
  (list minX maxY 0)
)
  )
  (if Wmat
(mapcar (function (lambda (x)
(trans x 1 0)
  )
)
pts
)
pts
  )
)
  )
)
;End of Supporting Functions
(setq *thisdrawing* (vla-get-activedocument (vlax-get-acad-object))
  *ACAD_LAYERS* (vla-get-layers *thisdrawing*)
)
(vla-startundomark *thisdrawing*)
(while (not SS)
(princ "\rSelect objects to demolish: ")
(setq SS (ssget))
)
(setq Ct 0
  SelectionLength (sslength SS)
  Scale (* 1.25 (getvar "Dimscale"))
)
(while (< Ct SelectionLength)
(setq Obj (vlax-ename->vla-object (ssname SS Ct))
  ObjName (vla-get-objectname Obj)
  ObjLayer (vla-get-layer Obj)
  ObjData (entget (ssname SS Ct))
)
(cond
((or (= ObjName "AcDbArc") (= ObjName "AcDbPolyline") (= ObjName "AcDbSpline"))
(cond
((= ObjName "AcDbPolyline")
(setq PLWidth (vla-get-constantwidth Obj)
  ODist (+ 3 PLWidth)
)
)
(T
(setq ODist 3)
)
)
(vlax-invoke Obj 'Offset ODist)
(setq Obj1Ent (entlast))
(vlax-invoke Obj 'Offset (* ODist -1))
(setq Obj2Ent (entlast))
(setq Obj1 (vlax-ename->vla-object Obj1Ent)
  Obj2 (vlax-ename->vla-object Obj2Ent)  
  Obj1End (vlax-curve-getendpoint Obj1)
  Obj2End (vlax-curve-getendpoint Obj2)
)
(cond
((= ObjName "AcDbPolyline")
(vla-put-constantwidth Obj1 0)
(vla-put-constantwidth Obj2 0)
)
)
(command "._pline" Obj1End Obj2End "")
(setq Obj3Ent (entlast))
(setq OldPeditAccept (getvar "peditaccept"))
(setvar "peditaccept" 1)
(command "._pedit" "M" Obj3Ent Obj1Ent Obj2Ent "" "j" "0" "c" "")
(setvar "peditaccept" OldPeditAccept)
(command "._-bhatch" "s" Obj3Ent "" "P" "Ansi31" scale "0" "")
(command "._erase" Obj3Ent "")
(setq Obj3Ent (entlast)
  Obj3 (vlax-ename->vla-object Obj3Ent)
)
(cond
((not (tblsearch "LAYER" "$DEMOHATCH"))
(setq NewLayer (vla-add *ACAD_LAYERS* "$DEMOHATCH"))
(vla-put-color NewLayer 8)
(cond
((= (getvar "pstylemode") 0)
(vla-put-plotstylename NewLayer "highlight")
)
)
)
)
(vla-put-layer Obj3 "$DEMOHATCH")
(ssdel (ssname SS Ct) SS)
(setq ct (- ct 1))
)
)
(setq Ct (+ Ct 1))
)
(cond
(SS
(draw-pl (list (ss-get-boundingbox ss NIL)));_test in UCS return the wcs box
(setq Obj3Ent (entlast)
  Obj3 (vlax-ename->vla-object Obj3Ent)
)
(vlax-invoke Obj3 'Offset 3)
(command "._erase" Obj3Ent "")
(setq Obj3Ent (entlast)
  Obj3 (vlax-ename->vla-object Obj3Ent)
)
(command "._-bhatch" "s" Obj3Ent "" "P" "Ansi31" scale "0" "")
(command "._erase" Obj3Ent "")
(setq Obj3Ent (entlast)
  Obj3 (vlax-ename->vla-object Obj3Ent)
)
(cond
((not (tblsearch "LAYER" "$DEMOHATCH"))
(setq NewLayer (vla-add *ACAD_LAYERS* "$DEMOHATCH"))
(vla-put-color NewLayer 8)
(cond
((= (getvar "pstylemode") 0)
(vla-put-plotstylename NewLayer "highlight")
)
)
)
)
(vla-put-layer Obj3 "$DEMOHATCH")
)
)
(vla-endundomark *thisdrawing*)
(princ)
)

[alanjt]

The coding here should help to close the two parallel curves. That's basically what I'm doing with it - offset either, then 'join' as one object. My method just robs everything from one curve and entmods it into the other.

[alanjt]

It actually only took a few minor edits...

Code: [Select]

(defun c:OPL (/ _subst _fixLast _reverseLWPPoints filter ss wd/2 offlst dxf210)
  ;; Offset LWPolyline & join
  ;; Alan J. Thompson, 08.03.11

  (vl-load-com)

  (defun _subst (p v l) (subst (cons p v) (assoc p l) l))

  (defun _fixLast (l) (reverse (cons '(42 . 0.) (cdr (reverse l)))))

  (defun _reverseLWPPoints (d / l n)
    (foreach x d (and (vl-position (car x) '(10 40 41 42)) (setq l (cons x l))))
    (setq l (append (cdddr l) (list (car l) (cadr l) (caddr l))))
    (while l
      (setq n (append n
                      (list (assoc 10 l)
                            (cons 40 (cdr (assoc 41 l)))
                            (cons 41 (cdr (assoc 40 l)))
                            (cons 42 (- (cdr (assoc 42 l))))
                      )
              )
            l (cddddr l)
      )
    )
    n
  )

  (setq filter '((0 . "LWPOLYLINE")))

  (if (or (ssget "_I" filter) (prompt "\nSelect LWPolylines to outline: ") (ssget "_:L" filter))
    (progn
      (initget 6)
      (setq *OPL:Width*
             (cond ((getdist (strcat "\nTotal width for offset: <"
                                     (rtos (cond (*OPL:Width*)
                                                 ((setq *OPL:Width* 1.))
                                           )
                                     )
                                     ">: "
                             )
                    )
                   )
                   (*OPL:Width*)
             )
      )
      (vlax-for x (setq ss (vla-get-activeselectionset
                             (cond (*AcadDoc*)
                                   ((setq *AcadDoc* (vla-get-activedocument
                                                      (vlax-get-acad-object)
                                                    )
                                    )
                                   )
                             )
                           )
                  )
        (setq offlst nil)
        (if (vl-every '(lambda (d / o)
                         (if (not (vl-catch-all-error-p
                                    (setq o (vl-catch-all-apply 'vlax-invoke (list x 'Offset d)))
                                  )
                             )
                           (setq offlst (cons (entget (vlax-vla-object->ename (car o))) offlst))
                         )
                       )
                      (list (setq wd/2 (/ *OPL:Width* 2.)) (- wd/2))
            )
          (progn
            (if (vlax-curve-isClosed x)
              (foreach e offlst (entmod (_subst 43 0. e)))
              (progn
                (entmod
                  (_subst
                    43
                    0.
                    (_subst
                      70
                      (if (zerop (vlax-get x 'LinetypeGeneration))
                        1
                        129
                      )
                      (_subst
                        90
                        (+ 2 (cdr (assoc 90 (car offlst))) (cdr (assoc 90 (cadr offlst))))
                        (append
                          (_fixLast (vl-remove (setq dxf210 (assoc 210 (car offlst))) (car offlst)))
                          (_fixLast (_reverseLWPPoints (cadr offlst)))
                          (list dxf210)
                        )
                      )
                    )
                  )
                )
                (entdel (cdr (assoc -1 (cadr offlst))))
              )
            )
            (vl-catch-all-apply 'vla-delete (list x))
          )
          (foreach e offlst (entdel (cdr (assoc -1 e))))
        )
      )
      (vla-delete ss)
    )
  )
  (princ)
)

[hermanm]

For the record,

the inverse function is:

vlax-vla-object->ename
 
Transforms a VLA-object to an AutoLISP entity

(vlax-vla-object->ename obj)

Arguments

obj

    A VLA-object.

Return Values

An AutoLISP entity name (ename data type).

[cmwade77]

Also related to VLA objects, I have the following code that seems to be giving me problems. I have added remarks where the problems appear to be, any ideas?

Code: [Select]

(defun xmethodflip (mode / *ACAD_DOC* xInsPt xLayer xScaleX xScaleY xRotation xPath Obj2); Mode - O = Overlay / A = Attach
(vl-load-com)
(setq *ACAD_DOC* (vla-get-ActiveDocument (vlax-get-acad-object)))
;Supporting Functions
(defun x2a_isNested (name / SS filter)
(setq Filter (cons 2 name)
  ss (ssget "_X" (list filter))
)
(cond
(ss
nil
)
(T
T
)
)
)
;End of Supporting Functiona
(vlax-for Obj (vla-get-blocks *ACAD_DOC*)
(cond
((= (vla-get-isxref Obj) :vlax-true)
(setq xRname (vla-Get-Name Obj))
(cond
((not (x2a_isNested xRname))
(setq xPath (vla-get-path Obj); This line works  
  xInsPt (vla-get-insertionpoint Obj); This line does not work, it returns: ActiveX Server returned the error: unknown name: InsertionPoint
  xLayer (vla-get-layer Obj); Similarly this line does not work
  xScaleX (vla-get-xscalefactor Obj); Does not work
  xScaleY (vla-get-yscalefactor Obj); Does not work
  xRotation (vla-get-rotation Obj); Does not work
)
(vl-cmdf "._-xref" "_d" xRname)
(vl-cmdf "._xref" (strcat "_" mode) xPath xInsPt xScaleX xScaleY xRotation)
(setq Obj2 (vlax-ename->vla-object (entlast)))
(vla-put-layer Obj2 xLayer)
)
)
)
)
)

(princ)
)
(defun C:x2a ()
(xmethodflip "a")
)
(defun C:x2o ()
(xmethodflip "o")
)

[Lee Mac]

By iterating through the Block Collection, you are operating with Block Definition Objects, not Block References.

Block Definition Objects do not have an InsertionPoint property, Scale or Rotation since they are defined at 1:1 Scale and Zero Rotation around an Origin Property (usually 0,0,0).

[cmwade77]

Thanks Lee, that makes sense, so here is what I have so far:

Code: [Select]

(defun xmethodflip (mode / *ACAD_DOC* *PaperSpace* *ModelSpace* xInsPt xLayer xScaleX xScaleY xScaleZ xRotation xPath Obj2 xObj xObjName); Mode - O = Overlay / A = Attach
(vl-load-com)
(setq *ACAD_DOC* (vla-get-ActiveDocument (vlax-get-acad-object))
  *PaperSpace* (vla-get-paperspace *ACAD_DOC*)
  *ModelSpace* (vla-get-modelspace *ACAD_DOC*)
)
;Supporting Functions
(defun x2a_NotNested (name / SS filter)
(setq Filter (cons 2 name)
  ss (ssget "_X" (list filter))
)
SS
)
;End of Supporting Functiona
(vlax-for Obj (vla-get-blocks *ACAD_DOC*)
(cond
((= (vla-get-isxref Obj) :vlax-true)
(setq xRname (vla-Get-Name Obj))
(cond
((setq SS (x2a_NotNested xRname))
(while (setq xObjName (ssname ss 0))
(setq xPath (vla-get-path Obj); This line works
    xObj (vlax-ename->vla-object xObjName)
  xInsPt (vlax-safearray->list (variant-value (vla-get-insertionpoint xObj)))  
  xLayer (vla-get-layer xObj)
  xScaleX (vla-get-xscalefactor xObj)
  xScaleY (vla-get-yscalefactor xObj)
  xScaleZ (vla-get-zscalefactor xObj)
  xRotation (vla-get-rotation xObj)
)
(vla-detach Obj)
(vl-cmdf "._-xref" (strcat "_" mode) xPath xInsPt xScaleX xScaleY xRotation)
(setq Obj2 (vlax-ename->vla-object (entlast)))
(vla-put-layer Obj2 xLayer)
(ssdel (ssname ss 0) ss)
)
)
)
)
)
)
(princ)
)
(defun C:x2a ()
(xmethodflip "a")
)
(defun C:x2o ()
(xmethodflip "o")
)
The problem now is that I need to determine which space each xref is referenced into and reinsert it into that space only. Also, I have tried using the vla-attachexternalreference but I can only seem to get it to use Overlay, not attach, any ideas there would be appreciated as well as it is a lot faster than the command line method.

I have tried:

Code: [Select]

(cond
((= (strcase mode) "O")
(setq Obj2 (vla-attachexternalreference *ModelSpace* xPath (vl-filename-base xPath) (vlax-3D-point xInsPt) xScaleX xScaleY xScaleZ xRotation :vlax-true))
)
((= (strcase mode) "A")
(setq Obj2 (vla-attachexternalreference *ModelSpace* xPath (vl-filename-base xPath) (vlax-3D-point xInsPt) xScaleX xScaleY xScaleZ xRotation :vlax-false))
)
)

[alanjt]

So, did you get your first problem resolved? Did any of my code help?

[cmwade77]

So, did you get your first problem resolved? Did any of my code help?

Yes, I did, that is another routine and the first code helped, I have not yet integrated your merging plines into my routine. For now I am using PEDIT, but I want to change that so that I don't have to mess around with changing variables.

[cmwade77]

Ok, so I have just about got this latest code for the xref attach to overlay/overlay to attach command:

Code: [Select]

(defun xmethodflip (mode / *ACAD_DOC* *PaperSpace* *ModelSpace* *PaperSpaceID* *ModelSpaceID* *Active* *ActiveID* Temp xIsClipped XNameList BlockCollection xInsPt xLayer xScaleX xScaleY xScaleZ xRotation xPath Obj2 xObj xObjName xLayout xOwnerID); Mode - O = Overlay / A = Attach
(vl-load-com)
(setvar "cmdecho" 0)
(setq *ACAD_DOC* (vla-get-ActiveDocument (vlax-get-acad-object))
  *PaperSpace* (vla-get-paperspace *ACAD_DOC*)
  *ModelSpace* (vla-get-modelspace *ACAD_DOC*)
  *PaperSpaceID* (vla-get-objectid *PaperSpace*)
  *ModelSpaceID* (vla-get-objectid *ModelSpace*)
)
;Supporting Functions
(defun x2a_NotNested (name / SS filter)
(setq Filter (cons 2 name)
  ss (ssget "_X" (list filter))
)
SS
)
(defun x2a_r2d (rad /)
(/ (* rad 180) pi)
)
(defun x2a_GetXclip ( ename / result );Code from http://www.theswamp.org/index.php?topic=17980.msg217538#msg217538

   (vl-catch-all-apply
  '(lambda ( / object )
   (if
   (and
   (eq "INSERT"
   (cdr
   (assoc 0
   (entget ename)
   )
   )
   )
   (eq :vlax-true
   (vla-get-HasExtensionDictionary
   (setq object
   (vlax-ename->vla-object ename)
   )
   )
   )
   )
   (setq result
   (entget
   (vlax-vla-object->ename
   (vla-item
   (vla-item
   (vla-getExtensiondictionary object)
   "ACAD_FILTER"
   )
   "SPATIAL"
   )
   )
   )
   )
   )
   )
   )
   result
)
;End of Supporting Functiona
(setq BlockCollection (vla-get-blocks *ACAD_DOC*))
(vlax-for Obj BlockCollection
(cond
((= (vla-get-isxref Obj) :vlax-true)
(setq xRname (vla-Get-Name Obj))
(cond
((and (setq SS (x2a_NotNested xRname)) (= (vl-position xRname xNameList) nil))
(setq Ct (sslength SS)
  xPath (vla-get-path Obj)
  XNameList (cons xRname XNameList)
)
(repeat Ct
(setq xObj (vlax-ename->vla-object (ssname ss 0))
  xInsPt (cons (vlax-safearray->list (variant-value (vla-get-insertionpoint xObj))) xInsPt)  
  xOwnerID (cons (vla-get-ownerid xObj) xOwnerID)
  xScaleX (cons (vla-get-xscalefactor xObj) xScaleX)
  xScaleY (cons (vla-get-yscalefactor xObj) xScaleY)
  xScaleZ (cons (vla-get-zscalefactor xObj) xScaleZ)
  xRotation (cons (vla-get-rotation xObj) xRotation)
  xLayer (cons (vla-get-layer xObj) xLayer)
  xIsClipped (cons (x2a_GetXClip (vlax-vla-object->ename xObj)) xIsClipped)
)
(ssdel (ssname ss 0) ss)
)
(vla-detach Obj)
(setq Ct2 0)
(repeat Ct
(cond
((and (= *PaperSpaceID* (nth Ct2 xOwnerID)) (= (getvar "tilemode") 0) (= (getvar "cvport") 1))
(setq xLayout *PaperSpace*)
)
((and (= *ModelSpaceID* (nth Ct2 xOwnerID)) (or (= (getvar "tilemode") 1) (/= (getvar "cvport") 1)))
(setq xLayout *ModelSpace*)
)
(T
(princ (strcat "\n" xRname " was not in current space....skipping instance."))
(setq xLayout nil)
)
)
(cond
(xLayout
(cond
((or (< (nth Ct2 xScaleX) 0) (< (nth Ct2 xScaleY) 0) (< (nth Ct2 xScaleZ) 0)); This is put here for xRefs that have been mirrored.
(vl-cmdf "._-xref" (strcat "_" mode) xPath (nth Ct2 xInsPt)(nth Ct2 xScaleX) (nth Ct2 xScaleY) (x2a_r2d (nth Ct2 xRotation)))
(setq Obj2 (vlax-ename->vla-object (entlast)))
)
(T
(cond
((= (strcase mode) "O")
(setq Obj2 (vla-attachexternalreference xLayout xPath (vl-filename-base xPath) (vlax-3D-point (nth Ct2 xInsPt)) (nth Ct2 xScaleX) (nth Ct2 xScaleY) (nth Ct2 xScaleZ) (nth Ct2 xRotation) :vlax-true))
)
((= (strcase mode) "A")
(setq Obj2 (vla-attachexternalreference xLayout xPath (vl-filename-base xPath) (vlax-3D-point (nth Ct2 xInsPt)) (nth Ct2 xScaleX) (nth Ct2 xScaleY) (nth Ct2 xScaleZ) (nth Ct2 xRotation) :vlax-false))
)
)
)
)
(vla-put-layer Obj2 (nth Ct2 xLayer))
(cond
((nth Ct2 xIsClipped)
(princ)
;Stuff needs to be inserted here to process the xclipping.
)
)
)
)
(setq Ct2 (+ Ct2 1))
)
)
)
)
)
)
(princ)
)
(defun C:x2a ()
(xmethodflip "a")
)
(defun C:x2o ()
(xmethodflip "o")
)
The problem that I am having is in handling xclips, if an xref is clipped, it looses it's clip during this process. Thank to the swamp, I am able to get the xclip information, but it is so long that I am not sure how to handle it or what the best way to do so would be. Any suggestions?