TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: V-Man on July 16, 2007, 03:21:25 PM
-
I need some assistance with my code. I want to be able to get the area of all lwpolylines and form the Square footage of each into a list for later camparison.
Once the list is made I want to go back through all lwpolylines one at a time, get the area in SF and compare the SF to the list. If a match is found I want to hatch that particular lwpolyline.
Then it can continue with the rest of the lwpolylines until complete.
(In a nutshell I am trying to find duplicate areas within my floorplan and enote where (if any) they are.
Help please. Thanks,
(setq ss (ssget "x" '((0 . "lwpolyline") (8 . "ROOMS") (70 . 1))))
(if ss
(progn
(setq n (1- (sslength ss)))
(while (>= n 0)
(command "_.area" "_o" (ssname ss n))
(setq a (+ a (getvar "area"))
n (1- n))
)
)
)
-
Try this:
(defun c:test (/ ss lst)
(if (setq ss (ssget "x" '((0 . "lwpolyline") (8 . "ROOMS") (70 . 1))))
(progn
(setq lst (mapcar 'vlax-ename->vla-object (mapcar 'cadr (ssnamex ss))))
(setq lst (mapcar '(lambda (x) (list x (vla-get-area x))) lst))
)
)
lst
)
-
Try this:
(defun c:test (/ ss lst)
(if (setq ss (ssget "x" '((0 . "lwpolyline") (8 . "ROOMS") (70 . 1))))
(progn
(setq lst (mapcar 'vlax-ename->vla-object (mapcar 'cadr (ssnamex ss))))
(setq lst (mapcar '(lambda (x) (list x (vla-get-area x))) lst))
)
)
lst
)
Hi Alan!
I have a little cut your code...
(defun c:test (/ ss)
(if (setq ss (ssget "x" '((0 . "lwpolyline") (8 . "ROOMS") (70 . 1))))
(mapcar 'vlax-curve-getArea (mapcar 'cadr (ssnamex ss)))
)
)
-
Thanks for replying.
(defun c:test (/ ss)
(if (setq ss (ssget "x" '((0 . "lwpolyline") (8 . "ROOMS") (70 . 1))))
(mapcar 'vlax-curve-getArea (mapcar 'cadr (ssnamex ss)))
)
)
How do I search through the list to find any duplicate square footage's?
-
Something like this:
(defun c:test (/ ss lst result match)
(if (setq ss (ssget "x" '((0 . "lwpolyline") (8 . "ROOMS") (70 . 1))))
(progn
(setq lst (mapcar 'vlax-curve-getArea (mapcar 'cadr (ssnamex ss))))
(print lst)
(foreach itm lst
(setq match (vl-remove-if-not '(lambda(x) (equal itm x 0.0001)) lst))
(if (> (length match) 1)
(setq result (cons itm result))
)
)
(print result)
)
)
(princ)
)
-
I have a little cut your code...
(defun c:test (/ ss)
(if (setq ss (ssget "x" '((0 . "lwpolyline") (8 . "ROOMS") (70 . 1))))
(mapcar 'vlax-curve-getArea (mapcar 'cadr (ssnamex ss)))
)
)
Hi Evgeniy! :-)
I just thought he wanted to keep track of the owner of the area.
-
Thanks much Alan.
Now I am in the home stretch. Now I want to go through and get the area of all lwpolylines on the ROOM layer and compare each to the list and where it finds a match then hatch the lwpolyline with the duplicate.
-
I think you have enough parts & pieces to do that.
Put the code together & let's see what you have.
-
First of all Many thanks Alan.
I finally figured it out. Here is the final code.
(defun c:getduplicate ( )
(getdupareas)
(setq ss (ssget "x" '((0 . "lwpolyline") (8 . "ROOM") (70 . 1))))
(if ss
(repeat (setq n (sslength ss))
(setq n (1- n))
(command "_.area" "_o" (ssname ss n))
(setq a (getvar "area"))
(if (member a result)
(command ".hatch" "HONEY" "140" "" (ssname ss n) "")
)
)
)
)
(defun getdupareas ();(/ ss lst result match)
(if (setq ss (ssget "x" '((0 . "lwpolyline") (8 . "ROOM") (70 . 1))))
(progn
(setq lst (mapcar 'vlax-curve-getArea (mapcar 'cadr (ssnamex ss))))
;(print lst)
(foreach itm lst
(setq match (vl-remove-if-not '(lambda(x) (equal itm x 0.0001)) lst))
(if (> (length match) 1)
(setq result (cons itm result))
)
)
(print result)
)
)
(princ)
)
-
I think I spoke to soon. It's not quite working correctly. Help
-
I need some assistance with my code. I want to be able to get the area of all lwpolylines and form the Square footage of each into a list for later camparison.
Once the list is made I want to go back through all lwpolylines one at a time, get the area in SF and compare the SF to the list. If a match is found I want to hatch that particular lwpolyline.
Then it can continue with the rest of the lwpolylines until complete.
(In a nutshell I am trying to find duplicate areas within my floorplan and enote where (if any) they are.
Are you sure, that by testing for the area, it will allow you to get the duplicates?.... what happen when one room it is equal to another and it is not a duplicate?... or in your particular case, that never going to happen?
Post a simple drawing if you can, and also, have you tried to use the autocad built-in command overkill and eliminate the duplicates? - i think the word is OVERLAP instead of duplicates....
-
Are you sure, that by testing for the area, it will allow you to get the duplicates?.... what happen when one room it is equal to another and it is not a duplicate?... or in your particular case, that never going to happen?
Post a simple drawing if you can, and also, have you tried to use the autocad built-in command overkill and eliminate the duplicates? - i think the word is OVERLAP instead of duplicates....
You are correct. This is a flaw in the searching for true duplicates. I have ran into the routine finding duplicate areas but not duplicate lwpolylines.
This is a problem that I did not think of. Therefore, the routine I made will not work for what I am trying to get accomplished. As for overkill command, I cannot
use this because our lwpolylines have "smart" information attached via XDATA and if there are 2 lwpolylines occupying the same space I do not know which lwpolyline
has the XDATA attached to it, hence my problem. I was going to use this routine to "locate" the lwpolylines and the user would have to manually check to see which needs
to be deleted. I hope I clarified this.
-
You are correct. This is a flaw in the searching for true duplicates. I have ran into the routine finding duplicate areas but not duplicate lwpolylines.
This is a problem that I did not think of. Therefore, the routine I made will not work for what I am trying to get accomplished. As for overkill command, I cannot
use this because our lwpolylines have "smart" information attached via XDATA and if there are 2 lwpolylines occupying the same space I do not know which lwpolyline
has the XDATA attached to it, hence my problem. I was going to use this routine to "locate" the lwpolylines and the user would have to manually check to see which needs
to be deleted. I hope I clarified this.
I see, I do not have my old lisp functions here (where I'm doing some cleaning) I think I might have something and for the xdata, that can be easy to filter out too.. If I do/can I'll post here later.
ps> for your signature, you use map, have you tried to use the clean-up tools (some say are pretty good, and could work for this case)
-
I see, I do not have my old lisp functions here (where I'm doing some cleaning) I think I might have something and for the xdata, that can be easy to filter out too.. If I do/can I'll post here later.
That would be great.
-
I see, I do not have my old lisp functions here (where I'm doing some cleaning) I think I might have something and for the xdata, that can be easy to filter out too.. If I do/can I'll post here later.
That would be great. Can you or anyone out there have any ideas on how to accomplish what I am trying to do?
ps> for your signature, you use map, have you tried to use the clean-up tools (some say are pretty good, and could work for this case)
Yea I tried to use them with no luck.
-
I see, I do not have my old lisp functions here (where I'm doing some cleaning) I think I might have something and for the xdata, that can be easy to filter out too.. If I do/can I'll post here later.
That would be great. Can you or anyone out there have any ideas on how to accomplish what I am trying to do?
ps> for your signature, you use map, have you tried to use the clean-up tools (some say are pretty good, and could work for this case)
Yea I tried to use them with no luck.
As I said, if I find the function I did for something similar, I'll post the function here... lately I do not write in lisp anymore, only post old code.
-
Don;
Looks like you have being help by Gile using his nice simple function no?... good then!
-
Yea, I saw that there was another thread basically doing what I want. I did request if the routine by Gile could be made for multiple selection and ronjonp was so nice to respond with..... Thanks ronjonp
(defun c:duplicated? (/ ss1 ent ss)
(setq ss1 (ssget))
(if ss1
(progn
(setq ss1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1))))
(mapcar
'(lambda (e)
(setq ss (ssget "_X"
(vl-remove-if
'(lambda (x) (member (car x) '(-1 5)))
(entget e)
)
)
)
(alert (strcat "\nObject duplicated "
(itoa (1- (sslength ss)))
" times."
)
)
)
ss1
)
)
)
(princ)
)
But... It gives you an alert dialog for every instance. I would like for it to hatch each duplicate not alert.
Almost there but I need a little assistance.
Thanks
-
Yea, I saw that there was another thread basically doing what I want. I did request if the routine by Gile could be made for multiple selection and ronjonp was so nice to respond with..... Thanks ronjonp
(defun c:duplicated? (/ ss1 ent ss)
(setq ss1 (ssget))
(if ss1
(progn
(setq ss1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1))))
(mapcar
'(lambda (e)
(setq ss (ssget "_X"
(vl-remove-if
'(lambda (x) (member (car x) '(-1 5)))
(entget e)
)
)
)
(alert (strcat "\nObject duplicated "
(itoa (1- (sslength ss)))
" times."
)
)
)
ss1
)
)
)
(princ)
)
But... It gives you an alert dialog for every instance. I would like for it to hatch each duplicate not alert.
Almost there but I need a little assistance.
Thanks
dvarino,
See if this doees what you need:
(defun c:fdcp (/ ss3 ss2 ss1 ent ss hatch)
[color=blue] (setq ss1 (ssget
'((0 . "lwpolyline")
;;(8 . "ROOMS")
(-4 . "<or")
(70 . 1)
(70 . 129)
(-4 . "or>")
)
)
)[/color]
(if ss1
(progn
(setq ss1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1))))
(mapcar
'(lambda (e)
(if (not (member e ss2))
(progn
(setq
ss (ssget "_X"
(vl-remove-if
'(lambda (x) (member (car x) '(-1 5)))
(entget e)
)
)
)
(if (/= (1- (sslength ss)) 0)
(progn
(setq
ss2 (mapcar 'cadr (ssnamex ss))
ss3 (vl-remove (nth 0 ss2) ss2)
)
(princ (strcat "\n"
(itoa (1- (sslength ss)))
" duplicates..."
)
)
(mapcar '(lambda (e)
(setq hatch (vlax-invoke
(vla-get-modelspace
(vla-get-activedocument
(vlax-get-acad-object)
)
)
'addhatch
acHatchObject
"SOLID"
:vlax-true
)
)
(vlax-invoke
hatch
'appendouterloop
(list (vlax-ename->vla-object e))
)
(vla-evaluate hatch)
)
ss3
)
)
)
)
)
)
ss1
)
)
)
(princ)
)
Ron
-
I get the following when I select the lwpolylines...
Command:
DUPLICATED?
Select objects: Specify opposite corner: 2 found
Select objects:
1 duplicates...; error: Parameter not optional
-
Possibly you selected a polyline that was not closed?
*edit I updated the code above to select only closed polylines regardless of PLINEGEN setting.
See if that helps.
-
Still a no go. I get the same error. I did notice that fi there are no duplicates at all then the routine does not fail (error out) but if there ARE duplicates then I get......
I get the following when I select the lwpolylines...
Quote
Command:
DUPLICATED?
Select objects: Specify opposite corner: 2 found
Select objects:
1 duplicates...; error: Parameter not optional
This is after I used your revised code.
-
How about a different identifier than hatch....give this a whirl:
(defun c:fdcp (/ ss3 ss2 ss1 ent ss hatch obj)
(setq ss1 (ssget
'((0 . "lwpolyline")
;;(8 . "ROOMS")
(-4 . "<or")
(70 . 1)
(70 . 129)
(-4 . "or>")
)
)
)
(if ss1
(progn
(setq ss1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1))))
(mapcar
'(lambda (e)
(if (not (member e ss2))
(progn
(setq
ss (ssget "_X"
(vl-remove-if
'(lambda (x) (member (car x) '(-1 5)))
(entget e)
)
)
)
(if (/= (1- (sslength ss)) 0)
(progn
(setq
ss2 (mapcar 'cadr (ssnamex ss))
ss3 (vl-remove (nth 0 ss2) ss2)
)
(princ (strcat "\n"
(itoa (1- (sslength ss)))
" duplicates..."
)
)
(mapcar '(lambda (e)
(setq obj (vlax-ename->vla-object e))
[color=green] (vla-put-constantwidth obj 2)
(vla-put-color obj 3)[/color]
)
ss3
)
)
)
)
)
)
ss1
)
)
)
(princ)
)
-
Worked like a dream. Many thanks to you ronjonp.
-
Glad it worked for you :)......