Visual LISP, AutoLISP and General Customization

Visual LISP, AutoLISP and General Customization

Reply
Contributor
kylegoltsch
Posts: 17
Registered: ‎07-22-2011
Message 1 of 5 (287 Views)
Accepted Solution

Open Geometry

287 Views, 4 Replies
07-22-2011 10:29 AM

I am running AutoCad 2000 and need to manipulate over 12,000 .dxf files.  I would like to automatically select all open geometries within a file and move them to a cetain layer.  Open geometry would be defined as "any entity that has a an end point that no other entity has".

 

A clear example of this would be 1 line that touches no other on at least 1 end.

 

I would like to add this to a lisp routine that I already have to automatically open, perform some work, save back as a dxf and overwrite the existing, close and open next dxf file , repeat until all files in a folder are complete.

 

Any help would be greatly appreciated!


kylegoltsch wrote:

....  I would like to automatically select all open geometries within a file and move them to a cetain layer.  Open geometry would be defined as "any entity that has a an end point that no other entity has".

 

A clear example of this would be 1 line that touches no other on at least 1 end.

 

I would like to add this to a lisp routine that I already have to automatically open, perform some work, save back as a dxf and overwrite the existing, close and open next dxf file , repeat until all files in a folder are complete.

....


This seems to do that, in limited testing.  [Of course, take the (defun) wrapper away from the beginning and end if you incoporate it into a longer routine.]  No error handling or saving/restoring the current Layer or CMDECHO control or any of that, yet.

 

(defun C:smileysurprised:GL (/ entlist ptlist pt con); = Open Geometry to its own Layer
  (vl-load-com)
  (command ; include only if the Layer might not already exist in all files
    "_.layer"
      "_make" "OpenGeometry" ; choose your Layer name
      "_color" 222 "" ; choose your color
      "_ltype" "divide2" "" ; choose your linetype
    "" ; finish Layer command
  ); end command
  (setq
    entlist
      (vl-remove-if ; eliminate any closed Polylines/Ellipses/Splines
        'vlax-curve-isClosed
        (mapcar 'cadr ; list of all possible entities' names
          (ssnamex (ssget "_X" '((0 . "LINE,ARC,*POLYLINE,ELLIPSE,SPLINE"))))
        ); end mapcar
      ); end vl-remove-if & entlist
  ); end setq
  (foreach ent entlist ; make list of all open-ended entity start & end points
    (setq
      ptlist (cons (vlax-curve-getStartPoint ent) ptlist)
      ptlist (cons (vlax-curve-getEndPoint ent) ptlist)
    ); end setq
  ); end foreach
  (foreach ent entlist
    (setq
      pt (vlax-curve-getStartPoint ent); check 1st end
      con (vl-remove-if-not '(lambda (x) (equal x pt 1e-4)) ptlist); choose your precision
        ; list of occurrences of the same point [more than once = connecting entity]
    ); end setq
    (if (= (length con) 1); no other entity start/end connects
      (command "_chprop" ent "" "_layer" "OpenGeometry" ""); then - change Layer
      (progn ; else - 1st end connects to something; check 2nd end
        (setq
          pt (vlax-curve-getEndPoint ent); 2nd end
          con (vl-remove-if-not '(lambda (x) (equal x pt 1e-4)) ptlist)
        ); end setq
        (if (= (length con) 1); no other entity start/end connects
          (command "_chprop" ent "" "_layer" "OpenGeometry" ""); then - change Layer
        ); end if [no else - do nothing if it connects at both ends]
      ); end progn - else - 2nd end
    ); end if
  ); end foreach
); end defun

*Expert Elite*
Kent1Cooper
Posts: 5,649
Registered: ‎09-13-2004
Message 2 of 5 (274 Views)

Re: Open Geometry

07-22-2011 11:45 AM in reply to: kylegoltsch

kylegoltsch wrote:

....  I would like to automatically select all open geometries within a file and move them to a cetain layer.  Open geometry would be defined as "any entity that has a an end point that no other entity has".

 

A clear example of this would be 1 line that touches no other on at least 1 end.

 

I would like to add this to a lisp routine that I already have to automatically open, perform some work, save back as a dxf and overwrite the existing, close and open next dxf file , repeat until all files in a folder are complete.

....


This seems to do that, in limited testing.  [Of course, take the (defun) wrapper away from the beginning and end if you incoporate it into a longer routine.]  No error handling or saving/restoring the current Layer or CMDECHO control or any of that, yet.

 

(defun C:smileysurprised:GL (/ entlist ptlist pt con); = Open Geometry to its own Layer
  (vl-load-com)
  (command ; include only if the Layer might not already exist in all files
    "_.layer"
      "_make" "OpenGeometry" ; choose your Layer name
      "_color" 222 "" ; choose your color
      "_ltype" "divide2" "" ; choose your linetype
    "" ; finish Layer command
  ); end command
  (setq
    entlist
      (vl-remove-if ; eliminate any closed Polylines/Ellipses/Splines
        'vlax-curve-isClosed
        (mapcar 'cadr ; list of all possible entities' names
          (ssnamex (ssget "_X" '((0 . "LINE,ARC,*POLYLINE,ELLIPSE,SPLINE"))))
        ); end mapcar
      ); end vl-remove-if & entlist
  ); end setq
  (foreach ent entlist ; make list of all open-ended entity start & end points
    (setq
      ptlist (cons (vlax-curve-getStartPoint ent) ptlist)
      ptlist (cons (vlax-curve-getEndPoint ent) ptlist)
    ); end setq
  ); end foreach
  (foreach ent entlist
    (setq
      pt (vlax-curve-getStartPoint ent); check 1st end
      con (vl-remove-if-not '(lambda (x) (equal x pt 1e-4)) ptlist); choose your precision
        ; list of occurrences of the same point [more than once = connecting entity]
    ); end setq
    (if (= (length con) 1); no other entity start/end connects
      (command "_chprop" ent "" "_layer" "OpenGeometry" ""); then - change Layer
      (progn ; else - 1st end connects to something; check 2nd end
        (setq
          pt (vlax-curve-getEndPoint ent); 2nd end
          con (vl-remove-if-not '(lambda (x) (equal x pt 1e-4)) ptlist)
        ); end setq
        (if (= (length con) 1); no other entity start/end connects
          (command "_chprop" ent "" "_layer" "OpenGeometry" ""); then - change Layer
        ); end if [no else - do nothing if it connects at both ends]
      ); end progn - else - 2nd end
    ); end if
  ); end foreach
); end defun

Kent Cooper
Distinguished Contributor
markruys
Posts: 108
Registered: ‎10-02-2007
Message 3 of 5 (253 Views)

Re: Open Geometry

07-22-2011 02:11 PM in reply to: kylegoltsch

you should look into using objectdbx, it will do all your 12,000 files in a few minutes, but the catch is, it will loose the preview bitmaps.

 

Contributor
kylegoltsch
Posts: 17
Registered: ‎07-22-2011
Message 4 of 5 (220 Views)

Re: Open Geometry

07-24-2011 11:45 AM in reply to: Kent1Cooper

Did some extensive testing and it worked great.  I was able to incorporate it into my other lisp file that would open, close and save files.  

 

I look forward to running all 12,000 files.

 

Thanks so much for your help!

 

Kyle

*Expert Elite*
Kent1Cooper
Posts: 5,649
Registered: ‎09-13-2004
Message 5 of 5 (184 Views)

Re: Open Geometry

07-25-2011 11:07 AM in reply to: kylegoltsch

kylegoltsch wrote:

Did some extensive testing and it worked great.  I was able to incorporate it into my other lisp file....

I look forward to running all 12,000 files.

....


As "a person of a certain age," I can't help but think of that early-1960's folk/campfire classic, recorded by The Journeymen, the Kingston Trio, Peter Paul & Mary, and many others:

 

"....

12,000 files, 12,000 files, 12,000 files, 12,000 files,

You can make the function fix 12,000 files!

...."
 

 

 
[For instance: http://www.bing.com/videos/search?q=500+miles&mid=CD650A530AAFBDE7A210CD650A530AAFBDE7A210&view=deta...]

Kent Cooper
Post to the Community

Have questions about Autodesk products? Ask the community.

New Post
Need installation help?

Start with some of our most frequented solutions or visit the Installation and Licensing Forum to get help installing your software.