Topic: dxf code change?

[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