Is bpoly/boundary creation without user interaction possible?

[Pottersfriend]

Hi everyone,

 

New to the forums so let me first say thanks in advance. I'm not a programmer but I dabble so I'm looking for any and all help I can get.

 

I currently have a job where I'd like to reduce the time involved on some of our drawings but not sure if what I want to do is even possible.

 

Right now, using the bpoly or boundary command the user has to select an internal point to create a closed poly. What I'd like is to eliminate the user interaction. So would it be possible to create a lisp routine that could create a set of closed polys from a selection set similar to the objects in my attached image? In that image the user what have to click four times to create the needed four closed polys. It would be nice if a routine could select all the entities on the set layers and create them without any user interaction.

 

More details: The image is a simple example. The lines would always be construction lines but the angle could be anything. They would always offset equal distances (simple array in this case). The rectangle could be any shaped closed polygon, possibly even a circle, though we haven't run into that yet.

 

Hopefully that was somewhat understandable. Anything that might help point in the right direction would be great.

 

Thanks,

Darin

 

[Tharwat]

If I understood your idea well ....

 

(defun c:Test (/ selectionset)
 (vl-load-com)
 ;;; Tharwat 21. may. 2012 ;;;
 (if (setq selectionset (ssget "_x" '((0 . "*POLYLINE") (-4 . "&") (70 . 1))))
   ((lambda (integer / selectionsetname entity)
      (while
        (setq selectionsetname (ssname selectionset (setq integer (1+ integer))))
         (setq entity (vl-remove-if-not (function
                      (lambda (x)
                        (member (car x) '(0 8 10 67 70 90 100 410 210))
                      )
                    )
                    (entget selectionsetname))
         )
         (entmakex entity)
      ))
   -1
 )
   (princ))
(princ)
)

[MSasu]

Looks to me that the OP wasn't looking to replicate the existing contour, but to create a closed polyline contour on each and every closed areas (colored independently below) defined by intersecting the entities in his/her drawing:

 

[Tharwat]

I guess you're right Mircea ,

[pBe]

Looks to me that the OP wasn't looking to replicate the existing contour, but to create a closed polyline contour on each and every closed areas defined by intersecting the entities in his/her drawing:

 

Now that makes it a lot easier to code.

[Pottersfriend]

Yes, MSasu, you are correct. Thanks for the clarification.

[Pottersfriend]

So, does anyone have any suggestions? I knew it wasn't going to be easy but thought someone might know if it's possible. If it's not then I'll move on and just do it manually.

 

Thanks.

[pBe]

So, does anyone have any suggestions? I knew it wasn't going to be easy but thought someone might know if it's possible. If it's not then I'll move on and just do it manually.

Thanks.

 

It is possible, you can doi it manually for now if need be while your'e waiting for someone to get around to it but then again, maybe not, let's just say when it happens, it happens.

Forum members write the codes on their own time and not restricted by a time limit.

 

Are those contour lines with z-coordinates? or just a representation of the contour and at elevation 0? post a drawing example and we'll see what we can come up with.

 

---- like i always say... be patient -----

[BlackBox]

Very good [mind's] eye for detail, Pbe... The Z could throw some a speed bump. First thought is to create a selection set of these entities, and if a Z were to prevent a standard bpoly, then duplicate each entity (visible = false), flattening them, then produce the desired boundaries, and delete the duplicate (hidden) entities.

 

Error handling would allow for duplicates to be deleted no matter what.

 

Perhaps seeing (or writing) some code will bring other potential 'gotcha's' to light.

[fixo]

Here is a dirty method (create duplicate boundaries)

Try it on your drawing

 
(defun C:BON(/ *error* adoc a ALE_IsInside ang b en frame fuzz group-by-num i ints ipts mp osm p1 p2 pts sset x xline xlines xset)

(defun *error* (msg)
(vla-endundomark (vla-get-activedocument
(vlax-get-acad-object))
)
(cond ((or (not msg)
(member msg '("console break" "Function cancelled" "quit / exit abort"))
)
)
((princ (strcat "\nError: " msg)))
)

(setvar "cmdecho" 1)
(if osm (setvar "osmode" osm))
(princ)
)
(defun group-by-num (lst num / ls ret)
(if (= (rem (length lst) num ) 0)
(progn
(setq ls nil)
(repeat (/ (length lst) num)
(repeat num (setq ls 
(cons (car lst) ls)
lst (cdr lst)))
(setq ret (append ret (list (reverse ls)))
ls nil)))
)
ret
)
(defun ALE_IsInside (ImpPnt EntNam / VlaObj LstEnt NewEnt EntAre)
;;; by *Alessi, Marc'Antonio
(vl-load-com) 
(setq VlaObj (vlax-ename->vla-object EntNam)) 
(cond 
( (not (vlax-property-available-p VlaObj 'Area)) 
(not (princ "It isn't possible to compute this object!")) 
) 
( (equal (vlax-curve-getclosestpointto VlaObj ImpPnt) ImpPnt 1e-10) 
(not (princ "Point is on object!")) 
) 
( (and 
(setq LstEnt (entlast)) 
(not (command "_.OFFSET" 0.0000001 EntNam "_NONE" ImpPnt "")) 
(eq LstEnt (setq NewEnt (entlast))) 
) 
(not 
(princ "It isn't possible to compute this point inside this 
object!") 
) 
) 
( T 
(setq EntAre (vlax-get-property (vlax-ename->vla-object NewEnt) 
'Area)) 
(entdel NewEnt) 
(> (vlax-get-property VlaObj 'Area) EntAre) 
) 
) 
)
;;---------------------------- main part -----------------------;;

(setq adoc (vla-get-activedocument
(vlax-get-acad-object))
acsp (vla-get-block(vla-get-activelayout adoc)))

(vla-startundomark adoc )
(setvar "cmdecho" 0)
(setq osm (getvar "osmode" ))
(setvar "osmode" 0)
(if (setq sset (ssget ":S"
'((-4 . "<or")
(-4 . "<and")
(0 . "LWPOLYLINE")
(70 . 1)
(-4 . "and>")
(0 . "ELLIPSE,CIRCLE")
(-4 . "or>")
)
)
)
(progn
(setq fuzz 1)
(setq frame (vlax-ename->vla-object (setq en (ssname sset 0))))
(vla-getboundingbox frame 'minp 'maxp)
(setq minp (vlax-safearray->list minp)
maxp (vlax-safearray->list maxp))
(command "zoom" "w" minp maxp)

(cond ((eq "AcDbPolyline" (vla-get-objectname frame))
(setq pts (vl-remove-if
'not
(mapcar '(lambda (x)
(if (= 10 (car x))
(cdr x)
)
)
(entget en)
)
)
))
(T (progn(setq leng (vlax-curve-getdistatparam frame (vlax-curve-getendparam frame)))
(setq n 0 step (/ leng 128))
(repeat 128
(setq pts (cons (vlax-curve-getpointatdist frame (* n step)) pts ))
(setq n (1+ n))))))
(setq xset (ssget "_CP" pts (list (cons 0 "XLINE"))))
(setq xlines
(mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp (mapcar 'cadr (ssnamex xset)))
)
)
(setq i 0)
(repeat (length xlines)
(setq xline (nth i xlines))
(setq ipts (vla-intersectwith frame xline 0))
(if (= 0
(vlax-safearray-get-l-bound
(setq ipts (vlax-variant-value ipts))
1
)
)
(progn
(setq ints (vlax-safearray->list ipts))
(setq ints (group-by-num ints 3))
(if (= 2 (length ints))
(progn
(setq mp (mapcar '(lambda (a b) (/ (+ a b) 2))
(car ints)
(cadr ints)
)
)
(setq ang (angle (vlax-get xline 'basepoint)
(vlax-get xline 'secondpoint)
)
)
(setq p1 (polar mp (+ ang 0.1) fuzz)
p2 (polar mp (- ang 0.1) fuzz)
)
(if (ALE_IsInside p1 en)
(vl-cmdf "-boundary" "a" "o" "r" "" p1 "")
)
(if (ALE_IsInside p2 en)
(vl-cmdf "-boundary" "a" "o" "r" "" p2 "")
)
)
)
)
)
(setq i (1+ i))
)
)
)
(*error* nil)
(princ)
)

 

~'J'~

[Pottersfriend]

pBe: I apologize if I came across as impatient, that was not my intent. Since I don't know much about programming and Autolisp it's hard for me to know what is even possible so I really was just curious to know if it was possible. And if it is possible, then I have no problem with waiting, especially since I do understand that people are giving of their free time to help, and I do greatly appreciate it. I am not on forums often so I think I need to read what I write a bit closer before I click that reply button.

 

Anyway, thanks for your help and as to your question about the z-coordinates, they will all be on an elevation of 0. Another thing I hadn't thought of, thanks for mentioning it.

[Pottersfriend]

fixo: Thank you very much for your code. Unfortunately, I ran into a couple of problems. First, when I check the routine it gives me the following errors:

 

; warning: local variable used as function: GROUP-BY-NUM

; warning: local variable used as function: ALE_ISINSIDE

; warning: local variable used as function: ALE_ISINSIDE

 

Experimenting on my own, I removed the above variables from the initial "defun" just to see if that would fix it. It did seem to pass the check but when I ran it on my drawing it gave the following error message:

 

Error: ActiveX Server returned an error: Element not found

 

I am running an educational version of 2011 Mechanical at home but ultimately I will be trying to have it run in 2004 Mechanical at work. The majority of the time I will be testing on 2011 at home. Not sure if it will matter that much but thought it was important to mention.

 

Thanks again,

Darin

[BlackBox]

The warnings your received are not uncommon when localizing a sub-function. In fact, this is considered to be a best practice in many situations, and will not prevent the code from loading or working properly.

[pBe]

pBe: I apologize if I came across as impatient, that was not my intent..........

Anyway, thanks for your help and as to your question about the z-coordinates, they will all be on an elevation of 0. Another thing I hadn't thought of, thanks for mentioning it.

 

No worries Pottersfriend.

 

Now what we need is a sample drawing. better post one, that way we would not be guiessing what works and what doesnt.

 

FIXOs code will work if the "contours" are Xlines. I guess with a little tweak on the code you can make it work for Lwpolylines/Lines.

 

Anyhoo.. try this code

 

(defun c:bpp (/ _mid p1 p2 ss ref pts)(vl-load-com)
(defun _mid  (p1 p2)
     (mapcar (function
                   (lambda (a b)
                         (/ (+ a b) 2.)))
             p1 p2))
(setq om (getvar 'osmode))
(if (and (setq p1 (getpoint "\nPick First point: "))
        (progn (initget 32)
               (setq p2 (getpoint p1 "\nPick Next point: ")))
        (setvar 'osmode 0)
        (setq ss   (ssget "_CP"
                          (list p1  p2
                                (polar (_mid p1 p2)
                                       (+ (/ pi 2.0) (angle p1 p2))
                                       0.1))
                          '((0 . "LWPOLYLINE") (8 . "contours")))))
    (progn 
      (command "_Line" "_non" p1 "_non" p2 "")
       (setq ref (vlax-ename->vla-object (entlast)))
       (repeat (sslength ss)
          (setq pts (cons (vlax-invoke  ref 'IntersectWith
                        (vlax-ename->vla-object(ssname ss 0))  acExtendNone) pts))
             (ssdel (ssname ss 0) ss))
       (vla-delete ref)
      (setq pts  (append (cons p1 (vl-sort pts (function (lambda (x y)
                                    (< (distance p1 x)(distance p1 y)))))) (list p2)))
      (mapcar (function (lambda (j k)
                (vl-cmdf "_.-boundary" "_A" "_I" "_N" "" "_O" "_P" "" "_non"
                      (_mid j k) "")))
                                pts (cdr pts))
       ))
   (setvar 'osmode om)  
   (princ)
   )

 

Pick two points that will intersect the contour lines within the boundary

 

Edited May 28, 2012 by pBe

[Pottersfriend]

RenderMan: Thanks. I didn't know that. Complete novice here. Still have the same problems with fixo's code though.

 

pBe: Sorry, no relation to the house-elf. Hadn't even thought that others might see it that way. I actually got the name from a tool used in pottery.

 

Thanks for the code, but as far as I can tell it doesn't seem to do anything when I try it. I assume per your picture that it requires the objects to be on those layers? It prompts to pick the points but then it doesn't seem to do anything else. Could be something I'm doing wrong.

 

I can post a drawing but I don't think it's necessary since it really is very basic. Just draw a rectangle (though the shape could be anything really) with some lines through it like shown in my initial post. Everything at an elevation of zero. The entities can be any layer, line type, polyline (closed or not), xlines, etc. that you need for the program to work.

 

Thanks.

[Blackfish]

@Pottersfriend: Defintely you should send something to help the guys coding; some codes work on a simple rectangle, but not on what you need. It doesn't need to be the whole drawing, just a real sample with similar difficulty as your drawing. And would be good to describe, as much as you can, a final purpose of your task... for what the boundaries will be used, maybe there is another way of doing the job.

 

@pBe: Maybe instead of picking two points would be more interesting to select an object (a closed polyline prefably) and then using it for 'crossing polygon' (CP) as far as I understand your code... I'm codeing nut

 

PS. These guys are geniuses, but not clairvoyants

Edited May 28, 2012 by Blackfish
I hope 'clairvoyant' is use in a proper meaning

[pBe]

RenderMan: Thanks. I didn't know that. Complete novice here. Still have the same problems with fixo's code though.

pBe: Sorry, no relation to the house-elf. Hadn't even thought that others might see it that way. I actually got the name from a tool used in pottery.

Thanks.

 

I see, make sense to me.

 

Thanks for the code, but as far as I can tell it doesn't seem to do anything when I try it. I assume per your picture that it requires the objects to be on those layers? It prompts to pick the points but then it doesn't seem to do anything else. Could be something I'm doing wrong.

 

I can post a drawing but I don't think it's necessary since it really is very basic. Just draw a rectangle (though the shape could be anything really) with some lines through it like shown in my initial post. Everything at an elevation of zero. The entities can be any layer, line type, polyline (closed or not), xlines, etc. that you need for the program to work.

Thanks.

 

I see, the way the code is written now, the entities intesrsecting the box should a Lwpolyline and resides on "contours" layer. Anyhoo. I will write another one to follow Blackfishs' suggestion. As for "entites can be any layer.." I believe what Blackfish said sums it up for you.

 

@pBe: Maybe instead of picking two points would be more interesting to select an object (a closed polyline prefably) and then using it for 'crossing polygon' (CP) as far as I understand your code... I'm codeing nut

 

Wilco.

 

PS. These guys are geniuses, but not clairvoyants

 

[pBe]

HYG:

(defun c:bpp  (/ adoc _HiLow Line _inters _mid _Bpoly ss ptsList insects e ref p1 p2)
(setq aDoc (vla-get-activedocument
              (vlax-get-acad-object)))
(defun _HiLow  (lev lev2 lst ent)
  [color=blue][b] (vlax-curve-getClosestPointTo
ent 
[/b][/color]     (list
         (apply lev (mapcar 'car lst))
         (apply lev2 (mapcar 'cadr lst))
         )[b][color=blue])[/color][/b])      
(defun Line  (doc p1 p2)
   (vla-addline
         (vlax-get (vla-get-ActiveLayout doc) 'Block)
         (vlax-3d-point p1)
         (vlax-3d-point p2)))
(defun _inters  (r obj / i pts)
   (repeat (setq i (sslength obj))
         (if (setq int  (vlax-invoke
                              r
                              'IntersectWith
                              (vlax-ename->vla-object
                                    (ssname obj
                                            (setq i (1- i))))
                              acExtendNone))
               (setq pts (cons int
                               pts)))
         )
   pts
   )
(defun _Bpoly  (rf_ p1_ p2_ pts_ / pts_)
   (vla-delete rf_)
   (setq pts_ (append (cons p1_
                            (vl-sort
                                  pts_
                                  (function
                                        (lambda (x y)
                                              (< (distance p1_ x)
                                                 (distance p1_ y))))))
                      (list p2_)))
   (mapcar (function
                 (lambda (j k)
                       (vl-cmdf
                             "_.-boundary" "_A"  "_I" "_N"
                             "" "_O"  "_P" "" "_non"
                             (mapcar (function
                 (lambda (a b)
                       (/ (+ a b) 2.)))
           j  k) "")))
           pts_
           (cdr pts_))
   (princ))
(if (and (setq ss (ssget "_+.:S:E:L" '((0 . "LWPOLYLINE"))))
              (setq ptsList
                         (mapcar 'cdr
                                 (vl-remove-if-not
                                       '(lambda (j)
                                              (= (Car j) 10))
                                       (entget (setq e    (ssname
                                                                ss
                                                                0))))))
              (setq insects (ssget "_CP" ptsList))
              (ssdel e insects)
              (setq ref (line aDoc
                              (setq p1 (_Hilow 'min 'max
                                               ptsList [color=blue][b]e[/b][/color]))
                              (setq p2 (_Hilow 'max 'min
                                               ptsList [b][color=blue]e[/color][/b]))))
              )
           (if (= (sslength insects)
                  (length (setq pts (_inters ref insects))))
                 (_Bpoly ref p1 p2 pts)
                 (progn (vla-delete ref)
                        (_Bpoly (setq ref (line aDoc
                                                (setq p1   (_Hilow 'min 'min
                                                                 ptsList [color=blue][b]e[/b][/color]))
                                                (setq p2   (_Hilow 'max 'max
                                                                 ptsList [b][color=blue]e[/color][/b]))))
                                p1  p2 (_inters ref insects)))
                 )
           )
     (princ)
     )
     

 

This time the code is not limited to entity type and layers except the "shape" should be a LWPOLYLINE

The direction of the contours preferably is the same-ish for all. (left-to-right/ right-to-left) NOT [uh-uhhh/can't happen/not gonna do it] going to work for "FAN" shape. you'll know it when you see it.

Edited May 29, 2012 by pBe
_Hilow Sub modified

[Pottersfriend]

pBe: Still no luck with your lisp routine. Attached is a very simple drawing to see if that helps. I used construction lines but they could be any type of line and trimmed if needed.

 

Thanks again.

 

Example.dwg

[pBe]

Cant test your drawing, stick stuck in 2009. besides TrueView cant covnert it either. try saveas 2007