Topic: dxf code change?

[ronjonp]

I can use this filter get all closed polylines in Acad 2004 but it does not work in 2005?

Code: [Select]

(setq s1 (ssget "x"'((0 . "LWPOLYLINE")(70 . 1))))

What is going on?

Thanks,

Ron

[MP]

Plinegen is encoded to group 70 (bit 7, value = 128) so you might try --

Code: [Select]

(ssget "x"
   '(   (0 . "LWPOLYLINE")
        (-4 . "&")
        (70 . 1)
    )
)

[Kerry]

ronjonp,
These work for me in AC2005

Code: [Select]


(setq s1-closed (ssget "x"'((0 . "LWPOLYLINE")(70 . 1))))
(setq s1-notClosed (ssget "x"'((0 . "LWPOLYLINE")(70 . 0))))
(setq s1-either (ssget "x" '((0 . "LWPOLYLINE"))))

[ronjonp]

MP,

That worked thanks

Kerry,

Still a no go in 2005??


Ron

[MP]

Great Ron. To be clear though, it's not a 2004/2005 issue. It's just coincidental that you happen to be using 2005 AND the lwpolylines you're currently dealing with have plinegen set. IOW, it would hold the same for 2004.

Cheers and have a great weekend.

:)

[Kerry]

Code: [Select]

Plinegen is encoded to group 70 (bit 7, value = 128) so you might try --


Michael

Thanks for the info. .. Most critical ..
I've been blisfully ignorant ..

[ronjonp]

Thanks for the info...

Where I'm going with this is:

User selects closed polylines in a drawing.
routine goes through each closed pline
grabs area of pline
inserts text with area in center of bounding box of object

Here is where I'm at....

Code: [Select]

(defun c:mareas (/ ss p selset)
(setq p 0)
(princ "\n Select closed polyines:")
(setq ss (ssget '((0 . "LWPOLYLINE")(-4 . "&")(70 . 1))))
(setq selset (sslength ss))

(repeat selset
  (setq ent (ssname ss p))
  (setq p (+ p 1))
  (command ".area" "object" ent)
  (setq txt (rtos (getvar "area") 2 2))
  (command ".text" "j" "mc" "0,0" ".125" "0" txt)
  (setq p (+ p 1))
)
)

I really suck at this lisp stuff  

[Jeff_M]

Ron, when you get tired of beating yourself up on this, I re-posted earlier today over at the AUGI.com forums a lisp originally written by Luis Esquival and modified by me that will do more than what you want. It would be real simple to reduce it down to only work with closed plines.

I must leave right now so if you can't find it over there (search for user 'miff') just let me know and I will re-post it here tomorrow or late tonight.

[MP]

Ain't this place great!

theswamp.org rocks.

[JohnK]

*lmao!*

[Mark]

I still say let them fish once in a while...................

[MP]

Who needs to fish, the fish are jumpin' in the boats!

[Mark]

hehehe.............  

[CAB]

Plinegen is encoded to group 70 (bit 7, value = 128) so you might try --

Code: [Select]

(ssget "x"
   '(   (0 . "LWPOLYLINE")
        (-4 . "&")
        (70 . 1)
    )
)

MP let me ask about your code.
Isn't the "&" implied? The reason I ask as I though they were the same.

Code: [Select]

'((0 . "LWPOLYLINE")(-4 . "&")(70 . 1))
 '((0 . "LWPOLYLINE")(70 . 1))
 
 You method is easer to read, but is it different?

[MP]

The (-4 . "&")(70 . 1) filter will be true if bit 0 (value 1) is set (bitwise logical and), thus (in this case) will be true for 70 group values of 1 or 129 (1 + 128), which is what we want: retrieve closed lwpolylines with no regard for the plinegen status.

The (70 . 1) filter by its lonesome is absolute: be true only if the 70 group value equals 1, so it will only retrieve closed lwpolylines that do not have plinegen set.

Does that clear it up?

:)

[JohnK]

Can i offer up some other cool info on the subject.

This info comes from an article Stig wrote. LINK

Gawd that article is good. I think its time for me to read it again.

[CAB]

MP
I see, that cleared it up,
Great info
Thanks
CAB

PS Nice link, Se7en
kudos Stig.

[Jeff_M]

I still say let them fish once in a while...................

Me too. That's one reason a sent him to another pond, once his bait here dried up he could go cast his line in there. If he caught the fish I threw in he'd be able to compare his work to Luis's/mine  

[ronjonp]

I've thrown this together with bits and pieces of code found here on the swamp. I don't know how to get ssget to loop through the objects in the selection set and run this code. I need to filter out all objects without an area property as well. Could someone help me out?

Thanks,

Ron

Code: [Select]

(defun c:test ( / ent obj obj_area txt inpt bbox)
(vl-load-com)

;CABS CODE
(defun getboundingbox (ent / minpt maxpt)
  (vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt)
  (mapcar 'vlax-safearray->list (list minpt maxpt))
  (setq llc (vlax-safearray->list minpt)
        urc (vlax-safearray->list maxpt)
  )
  (list llc urc)
)







(setq ent (entsel))
(setq bbox (getboundingbox (car ent)))
(setq obj      (vlax-ename->vla-object (car ent))
      obj_area (vlax-get-property obj 'Area)
)

;MARKS CODE
  (setq X1 (car llc))
  (setq Y1 (cadr llc))
  (setq Z1 (caddr llc))
  (setq X2 (car urc))
  (setq Y2 (cadr urc))
  (setq Z2 (caddr urc))
  (setq xmid (/ (+ X1 X2) 2))
  (setq ymid (/ (+ Y1 Y2) 2))
  (setq zmid (/ (+ Z1 Z2) 2))
  (setq mpt (list xmid ymid zmid))

(setq txt (rtos obj_area))
  (command ".text" "j" "mc" mpt (* (getvar "dimscale") 0.25) "0" txt)
(princ)
)


[Jeff_M]

I've thrown this together with bits and pieces of code found here on the swamp. I don't know how to get ssget to loop through the objects in the selection set and run this code. I need to filter out all objects without an area property as well. Could someone help me out?
Thanks,
Ron

Ron, using what MP showed to your initial inquiry filters for closed plines, so you don't need to check for the area property. Here's one way to loop a ss:

Code: [Select]


(if (setq sl (ssget '((0 . "LWPOLYLINE")
(-4 . "&")
(70 . 1)
)
     ))
    (progn
      (setq index -1)
      (while (< (setq index (1+ index)) (sslength sl))
(setq ent (ssname sl index))
;;; do whatever with your ent
)
      )
    )

Just a comment on the Text location. Although the method you are trying is one way, I'll suggest looking into one other: Since you have the ability to reference your ent as a vla-object, you could create a temp Region with it and get the centroid property of the region. This method ensures that you are getting the text within the pline, whare an odd shaped pline may get you undesired results using the bounding box method. And this doesn't give the result I was thinking of, either. But it is closer than the BB method....I should try these kinds of things before posting about them, instead of after.....

[CAB]

Here are a few ways to step through a ss, I collected this code.

Code: [Select]

;;   How to itterate through a selection set

(defun SELECTPOINTS (/ ss i en ed ip fl)
(and (setq ss (ssget "X" '((0 . "POINT"))))
     (setq i (sslength ss))
     (while (not (minusp (setq i (1- i))))
            (setq en (ssname ss i)
                  ed (entget en)
                  ip (cdr (assoc 10 ed))
                  fl (cons (cons en ip) fl))))
  fl
)

(defun selectpoints (/ ss en fl)
  (and (setq ss (ssget "X" '((0 . "POINT"))))
       (repeat (sslength ss)
         (setq fl (cons (cons (setq en (ssname ss 0))
                              (cdr (assoc 10 (entget en)))) fl))
         (ssdel en ss)))
  fl
)

(defun SelectPoints ( / ss i ename result )
    (if (setq ss (ssget "x" '((0 . "point"))))
        (repeat (setq i (sslength ss))
            (setq result
                (cons
                    (cons
                        (setq ename (ssname ss (setq i (1- i))))
                        (cdr (assoc 10 (entget ename)))
                    )
                    result
                )
            )
        )
    )
    result
)


(defun SelectPoints ( / ss i ename result )
    (if (setq ss (ssget "x" '((0 . "point"))))
      (progn
       (setq index 0)
       (repeat (sslength PUNTOS-EJE-X))
         (setq DXF10 (cdr (assoc 10 (entget (ssname PUNTOS-EJE-X index)))))
         ;;;add your code here
         (setq index (1+ index))
       )
      )  
    )
 )

[CAB]

OK I found the source.
http://theswamp.org/phpBB2/viewtopic.php?t=2883&highlight=selectpoints

[Mark]

Me too. That's one reason a sent him to another pond, once his bait here dried up he could go cast his line in there. If he caught the fish I threw in he'd be able to compare his work to Luis's/mine  

recieved and understood.  

[CAB]

Here is an area lisp, not the way TEXT is placed in te DWG.
http://theswamp.org/phpBB2/viewtopic.php?p=16451#16451

[ronjonp]

Code: [Select]

(defun c:test ( / ent obj obj_area txt inpt bbox)
(vl-load-com)

;CABS CODE
(defun getboundingbox (ent / minpt maxpt)
  (vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt)
  (mapcar 'vlax-safearray->list (list minpt maxpt))
  (setq llc (vlax-safearray->list minpt)
        urc (vlax-safearray->list maxpt)
  )
  (list llc urc)
)

(if (setq sl (ssget '((0 . "LWPOLYLINE")
         (-4 . "&")
         (70 . 1)
         )
            ))
    (progn
      (setq index -1)
      (while (< (setq index (1+ index)) (sslength sl))
   (setq ent (ssname sl index))
(setq ent (vlax-ename->vla-object ent))
(setq bbox (getboundingbox (car ent)))
(setq obj      (vlax-ename->vla-object (car ent))
      obj_area (vlax-get-property obj 'Area)
)



;MARKS CODE
  (setq X1 (car llc))
  (setq Y1 (cadr llc))
  (setq Z1 (caddr llc))
  (setq X2 (car urc))
  (setq Y2 (cadr urc))
  (setq Z2 (caddr urc))
  (setq xmid (/ (+ X1 X2) 2))
  (setq ymid (/ (+ Y1 Y2) 2))
  (setq zmid (/ (+ Z1 Z2) 2))
  (setq mpt (list xmid ymid zmid))

(setq txt (rtos obj_area))
  (command ".text" "j" "mc" mpt (* (getvar "dimscale") 0.25) "0" txt)
(princ)
))
))

So I added the ssget portion but now I'm getting:

; error: bad argument type: consp #<VLA-OBJECT IAcadLWPolyline

I read on Afralisp that you have to convert the objects to vla before you can work with them so I added

Code: [Select]

(setq ent (vlax-ename->vla-object ent)) What the heck am I doing??

Ron

[CAB]

ronjonp
Here is your code cleaned up a bit.
See if you can go line by line & document the code.
Post you results so someone can explain anything you don't understand.

Code: [Select]

(defun c:test (/ ent obj obj_area txt inpt bbox)
  (vl-load-com)

  (defun getboundingbox (obj / minpt maxpt)
    (vla-getboundingbox obj 'minpt 'maxpt)
    (mapcar 'vlax-safearray->list (list minpt maxpt))
    (setq llc (vlax-safearray->list minpt)
          urc (vlax-safearray->list maxpt)
    )
    (list llc urc)
  )

  (if (setq sl (ssget '((0 . "LWPOLYLINE")
                        (-4 . "&")
                        (70 . 1))
               )
      )
    (progn
      (setq units# (getvar "LUNITS"))
      (setq dwg_style (getvar "textstyle"))          ; get the current textstyle
      (setq styledata (tblsearch "style" dwg_style)) ; get the style data
      (setq dwg_ht (cdr (assoc 40 styledata)))       ; get the text height for that style
      (setq index -1)
      (while (< (setq index (1+ index)) (sslength sl))
        (setq ent (ssname sl index))
        (setq obj (vlax-ename->vla-object ent))
        (setq bbox (getboundingbox obj)
              llc (car bbox)
              urc (cadr bbox)
              mpt (list (/ (+ (car llc) (car urc)) 2) (/ (+ (cadr llc) (cadr urc)) 2))
        )
       
        (setq obj_area (vlax-get-property obj 'area))
        (if (member units# '(3 4))
          (setq txt (strcat (rtos (/ obj_area 144) 2 2) " Sq. Ft."))
          (setq txt (strcat (rtos obj_area) " Sq. Units"))
        )
        (if (= dwg_ht 0)
          (command "text" "j" "mc" mpt "" "0" txt)
          (command "text" "j" "mc" mpt "0" txt)
        ) ; endif
        (princ)
      )
    )
  )
)

[ronjonp]

Here is the commented code:

Code: [Select]

(defun c:test (/ ent obj obj_area txt inpt bbox)
  (vl-load-com)

  (defun getboundingbox (obj / minpt maxpt) ;define function to get bounding box
    (vla-getboundingbox obj 'minpt 'maxpt)
    (mapcar 'vlax-safearray->list (list minpt maxpt))
    (setq llc (vlax-safearray->list minpt)
          urc (vlax-safearray->list maxpt)
    )
    (list llc urc)
  )

  (if (setq sl (ssget '((0 . "LWPOLYLINE") ;filter to select only closed plines
                        (-4 . "&")
                        (70 . 1))
               )
      )
    (progn ;then
      (setq units# (getvar "LUNITS")) ;see what units the drawing is using and save in units#
      (setq index -1) ;sets index to -1
      (while (< (setq index (1+ index)) (sslength sl)) ;first part kinda loses me...sslength gets number of objects in sset
        (setq ent (ssname sl index)) ;gets name of indexed element
        (setq obj (vlax-ename->vla-object ent)) ;turns ent into vla object
        (setq bbox (getboundingbox obj) ;uses function from above to get bounding box
              llc (car bbox) ;gets first element in list
              urc (cadr bbox) ;gets second element in list
              mpt (list (/ (+ (car llc) (car urc)) 2) (/ (+ (cadr llc) (cadr urc)) 2)) ;gets midpoint between llc and urc and combines into one list
        )
       
        (setq obj_area (vlax-get-property obj 'area)) ;gets area prop of vla object
        (if (member units# '(3 4)) ;not sure how this works
          (setq txt (strcat (rtos (/ obj_area 144) 2 2) " Sq. Ft."))
          (setq txt (strcat (rtos obj_area) " Sq. Units"))
        )
        (if (= dwg_ht 0) ;not sure how this works
          (command "text" "j" "mc" mpt "" "0" txt)
          (command "text" "j" "mc" mpt "" "0" txt)
        ) ; endif
        (princ)
      )
    )
  )
)

Can a multiple filter be setup....(setq sl (ssget '((0 . "LWPOLYLINE")(0 . "circle").

I was thinking it would be better to check if the entities selected had an area property greater than 0 and filter them out and run the routine....this way it would work on other objects other than closed plines.....I'll do some research on how to even begin this.

Thanks for all of your help,

Ron

[Jeff_M]

Hi ron,
Multiple filters like this are done thusly:
(setq sl (ssget '((0 . "POLYLINE,LWPOLYLINE,CIRCLE"))))

Here are the objects that have the area property, straight from the help file.  
object.Area

object

Arc, Circle, Ellipse, LightweightPolyline, Polyline, Region, Spline
The object or objects this property applies to.

Note, however, that arcs and unclosed plines have an area but they may not be desired for output......

You could include plines that are not closed, but whose start & end points are within an acceptable fuzz factor to qualify as closed....One example of this is the user draws a pline and actually selects the start point as the end point but does not use the 'close' option. You can check for this by using the vlax-curve- functions getstartpoint & getendpoint.

[Jeff_M]

Oh, and to clear this up:

Code: [Select]


(setq index -1)   ;sets index to -1
      (while (< (setq index (1+ index)) (sslength sl))   ;first part kinda loses me..

The index is set to -1 to initialize the variable. Then in the (while) condition we  are increasing the value of index by 1 each iteration ofd the loop. So the first time it is read index becomes 0 which is the first index available in a selection set, so that means the next line (setq ent (ssname sl index)) gets the first item in the ss. The next time through the loop, index becomes 1 and we can get the entity at (ssname sl index).....and so on until index is equal to sslength,  at which point the loop is exited since attempting to get (ssname sl index), where index is the same as the (sslength), will result in an error.

[ronjonp]

Here is what I have:

Code: [Select]


;Puts text with objects area in it unless it is 0.00*------Many thanks to the SWAMP.ORG for all the help

(defun c:rat (/ *error u-clayer getboundingbox llc urc s1 index ent obj bbox mpt obj_area txt deltext)
  (command ".undo" "begin")  
(vl-load-com)

;_____________________________
;Error function
;_____________________________

(defun *error* (msg)
   (if
      (not
        (member
          msg
          '("console break" "Function cancelled" "quit / exit abort" "")
        )
      )
       (princ (strcat "\nError: " msg))
    ) ; if
(setvar 'clayer u-clayer)
    (princ)
  ) ;end error function

;_____________________________
;Get User Variables
;_____________________________

(setq u-clayer (getvar 'clayer))
(if (tblsearch "layer" "area")
  (command "-layer" "thaw" "area" "on" "area" "")
  (princ "\n Layer 'area' Created")
)
(command ".-layer" "m" "area" "")
 
  (defun getboundingbox (obj / minpt maxpt)
    (vla-getboundingbox obj 'minpt 'maxpt)
    (mapcar 'vlax-safearray->list (list minpt maxpt))
    (setq llc (vlax-safearray->list minpt)
          urc (vlax-safearray->list maxpt)
    )
    (list llc urc)
  )
  (if (setq sl (ssget '((0 . "LWPOLYLINE,CIRCLE,REGION,POLYLINE,ELLIPSE,REGION,SPLINE"))

               )
      )
    (progn
      (setq index -1)
      (while (< (setq index (1+ index)) (sslength sl))
        (setq ent (ssname sl index))
        (setq obj (vlax-ename->vla-object ent))
        (setq bbox (getboundingbox obj)
              llc (car bbox)
              urc (cadr bbox)
              mpt (list (/ (+ (car llc) (car urc)) 2) (/ (+ (cadr llc) (cadr urc)) 2))
        )

        (setq obj_area (vlax-get-property obj 'area))
        (setq txt (strcat (rtos obj_area)))
        (command "text" "j" "mc" mpt (* (getvar "dimscale") 0.15) "0" txt)

        (princ)
        (setq deltext (setq s1 (ssget "x"'((0 . "Text")(8 . "area")(1 . "0.00*")))))
        (command ".erase" deltext "")

      )
    )
  )
  (command ".undo" "end")
 (princ)
(*error* "")
(setvar 'clayer u-clayer)
(princ (strcat (itoa index) " entities processed..."))
(princ)
)

I took out the Lunits part since our drawings are drawn in decimal. I'm sure there is a better way to filter out areas under 1 but this works for now. Thank you all very much.

Ron

[Kerry]

I've seen this repeated a couple of times, and feel compelled to comment :

Code: [Select]


  (defun getboundingbox (obj / minpt maxpt)
    (vla-getboundingbox obj 'minpt 'maxpt)
    (mapcar 'vlax-safearray->list (list minpt maxpt))
    (setq llc (vlax-safearray->list minpt)
          urc (vlax-safearray->list maxpt)
    )
    (list llc urc)
  )

This procedure has superfluous expressions ,

If you want a list of the points, this is sufficient.

Code: [Select]

(defun getboundingbox (obj / minpt maxpt)
  (vla-getboundingbox obj 'minpt 'maxpt)
  (mapcar 'vlax-safearray->list (list minpt maxpt))
)


.. and ronjonp ,
perhaps the first item in the locals variable declaration list should be *error*  not *error

[CAB]

ron
Try this. Create a text stile with a fixed text height say 5 units in height.
Then set it current and run your routine.

You miss copied the following code in your commented version of code and I did not give
you all the lines of code needed. SO here is the code i intended to give you.

Code: [Select]

;;  Check if the drawing height is set to 0:
(setq dwg_style (getvar "textstyle"))          ; get the current textstyle
(setq styledata (tblsearch "style" dwg_style)) ; get the style data
(setq dwg_ht (cdr (assoc 40 styledata)))       ; get the text height for that style
;;  If the height is zero the TEXT command ask for the user to enter the height
;;  If the height in NOT zero the TEXT command does not ask the user for the height
;;  So you my compensate by having two different number of prompts.
(if (= dwg_ht 0)
  (command "text" pt "" "0" txt) ; this one has an extra prompt for the height
  (command "text" pt "0" txt)
) ; endif


In the following code it is tested to see if the LUNITS is 3 or 4
If it is the AREA is divided by 144 to get square feet from square inches.
Then display the matching results.

Code: [Select]

(setq units# (getvar "LUNITS")) ; get the current units code
if (member units# '(3 4))   ;test units# to see if it is 3 or 4
  (setq txt (strcat (rtos (/ obj_area 144) 2 2) " Sq. Ft."))
  (setq txt (strcat (rtos obj_area) " Sq. Units"))
)


Jeff did a good job of explaining the code iterating through a selection set.

Hopefully I made these section more understandable.

[ronjonp]

So I have another question...  How would I set a counter so that the routine adds all the areas in the selset and output a total?

Code: [Select]

;Puts text with objects area in it unless it is 0.00*------Many thanks to the SWAMP.ORG for all the help

(defun c:test (/ *error* u-clayer getboundingbox llc urc s1 index ent obj bbox mpt obj_area txt deltext)
  (command ".undo" "begin")  
(vl-load-com)

;_____________________________
;Error function
;_____________________________

(defun *error* (msg)
   (if
      (not
        (member
          msg
          '("console break" "Function cancelled" "quit / exit abort" "")
        )
      )
       (princ (strcat "\nError: " msg))
    ) ; if
(setvar 'clayer u-clayer)
    (princ)
  ) ;end error function

;_____________________________
;Get User Variables
;_____________________________

(setq u-clayer (getvar 'clayer))
(if (tblsearch "layer" "area")
  (command "-layer" "thaw" "area" "on" "area" "")
  (princ "\n Layer 'area' Created")
)
(command ".-layer" "m" "area" "")
 
  (defun getboundingbox (obj / minpt maxpt)
    (vla-getboundingbox obj 'minpt 'maxpt)
    (mapcar 'vlax-safearray->list (list minpt maxpt))
    (setq llc (vlax-safearray->list minpt)
          urc (vlax-safearray->list maxpt)
    )
    (list llc urc)
  )
  (if (setq sl (ssget '((0 . "LWPOLYLINE,CIRCLE,REGION,POLYLINE,ELLIPSE,REGION,SPLINE"))

               )
      )
    (progn
      (setq index -1)
      (while (< (setq index (1+ index)) (sslength sl))
        (setq ent (ssname sl index))
        (setq obj (vlax-ename->vla-object ent))
        (setq bbox (getboundingbox obj)
              llc (car bbox)
              urc (cadr bbox)
              mpt (list (/ (+ (car llc) (car urc)) 2) (/ (+ (cadr llc) (cadr urc)) 2))
        )

        (setq obj_area (vlax-get-property obj 'area))
        (setq txt (strcat (rtos obj_area)))
        (command "text" "j" "mc" mpt (* (getvar "dimscale") 0.15) "0" txt)

        (princ)
      )
    )
  )
(setq deltext (setq s1 (ssget "x"'((0 . "Text")(8 . "area")(1 . "0.00*")))))
(command ".erase" deltext "")
(command ".undo" "end")
(princ)
(*error* "")
(setvar 'clayer u-clayer)
(princ (strcat (itoa index) " entities processed..."))
(princ)
)

[V-Man]

I think this will help.

Code: [Select]


      (setq n (1- (sslength sl)))
      (while (>= n 0)
        (command "_.area" "_o" (ssname sl n))
        (setq a (+ a (getvar "area"))
              n (1- n)))
      (prompt
(strcat "The TOTAL AREA of the selected\nItems is "
(strcat (rtos (/ a 144) 2 3)  " Square Feet.")))


[ronjonp]

Thanks dvarino