Page 1 of 3 123 LastLast
Results 1 to 10 of 25

Thread: Need some code... Any Lispers wanna take a crack at this?

  1. #1
    100 Club
    Join Date
    2006-12
    Posts
    106
    Login to Give a bone
    0

    Default Need some code... Any Lispers wanna take a crack at this?

    My old Lisp days are 20 years gone... I just can't get my head around this one.
    I need a routine to process some closed p-line regions, in batches or sometimes one at a time.

    I want to:

    1) Create a selection set from polywindows or picks, checking that all selections are indeed closed p-lines.

    2) Hatch each selection (using the current hatch and layer settings).

    3) Find the area of each selection.

    4) Insert text at or near the middle of each selection (using the current style and layer settings) indicating the corresponding area measurements.

    I wish I could still do these myself, but the skills really do fade with the passage of time...
    Thanks for the help!

  2. #2
    Certifiable AUGI Addict
    Join Date
    2001-03
    Location
    Tallahassee, FL USA
    Posts
    3,663
    Login to Give a bone
    0

    Default Re: Need some code... Any Lispers wanna take a crack at this?

    This code will select closed polylines and lwpolylines.
    Code:
     (ssget '((0 . "LWPOLYLINE,POLYLINE") (70 . 1)))
    Next step thru each item in the selection set to label, then hatch. What's your base units and what units do you want for area?

  3. #3
    100 Club
    Join Date
    2006-12
    Posts
    106
    Login to Give a bone
    0

    Default Re: Need some code... Any Lispers wanna take a crack at this?

    Quote Originally Posted by Tom Beauford View Post
    This code will select closed polylines and lwpolylines.
    Code:
     (ssget '((0 . "LWPOLYLINE,POLYLINE") (70 . 1)))
    Next step thru each item in the selection set to label, then hatch. What's your base units and what units do you want for area?
    I have to deal with many different units, as my plans come from several disciplines. I think just going with the defaults will be OK for this usage. I can convert between units later, where necessary.

  4. #4
    Certifiable AUGI Addict
    Join Date
    2001-03
    Location
    Tallahassee, FL USA
    Posts
    3,663
    Login to Give a bone
    0

    Default Re: Need some code... Any Lispers wanna take a crack at this?

    Finding the middle of each selection is the tricky part. Maybe someon else has a better idea, but for now this code places the text at the middle of the objects bounding box. Great for rectangles, less than perfect for irregular objects.
    Code:
    ;SqFtFields
    ; by: Tom Beauford
    ;^C^C^P(or C:SqFtFields (load "SqFtFields.lsp"));SqFtFields
    ; (load "SqFtFields.lsp") SqFtFields
    (defun c:SqFtFields (/ ss nn en ob )
      (princ "\nSelect closed Polylines ")
      (setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE") (70 . 1))))
      (repeat (setq nn (sslength ss))
        (setq en (ssname ss (setq nn (1- nn)))
       ob (vlax-ename->vla-object en)
       obid (vla-get-objectid ob)
        )
        (vla-getboundingbox ob 'll 'ur)
        (setq plarea (vlax-get-property ob 'Area)
              lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos obid 2 0) ">%).Area \\f \"%lu2%pr0%qf1%ps[±, ft²]%th44\">%")        ; 1=1 foot
              pntlist  (mapcar 'vlax-safearray->list (list ll ur))
              tpt (list(/(+(caar pntlist)(caadr pntlist))2.0)(/(+(cadar pntlist)(cadadr pntlist))2.0))
        )
        (command "mtext" tpt "j" "mc" "w" "0" lin "")
      ); repeat
    )
    The text are fields and will update if the objects are modified.

  5. #5
    All AUGI, all the time
    Join Date
    2015-10
    Location
    Belgrade, Serbia, Europe
    Posts
    564
    Login to Give a bone
    0

    Default Re: Need some code... Any Lispers wanna take a crack at this?

    I have created this code according to your request... It selects LWPOLYLINES and checks them for closed option (if not closed it closes them automatically), then it hatches them with default hatch and puts text with area number in center of polyline, for it previously create region from pline and obtains its centroid where it later puts area number...

    Code:
    (defun c:areahatchpolys ( / ss ssn k ent entA entarea entreg entregA cent)
    (vl-load-com)
    (prompt "\nSelect plines")
    (setq ss (ssget (list (cons 0 "LWPOLYLINE"))))
    (setq ssn (sslength ss))
    (setq k -1)
    (repeat ssn
    (setq k (+ k 1))
    (setq ent (ssname ss k))
    (setq entA (vlax-ename->vla-object ent))
    (setq entarea (vlax-get-Property entA 'Area))
    (if (eq (vlax-get-Property entA 'Closed) :vlax-false) (vlax-put-Property entA 'Closed :vlax-true))
    (vl-cmdf "region" ent "")
    (setq entreg (entlast))
    (setq entregA (vlax-ename->vla-object entreg))
    (setq cent (vlax-safearray->list (vlax-variant-value (vlax-get-Property entregA 'Centroid))))
    (vl-cmdf "_.explode" "l" "")
    (vl-cmdf "_.pedit" "l" "" "j" "p" "" "")
    (vl-cmdf "_.bhatch" "s" (entlast) "" "")
    (vl-cmdf "_.text" cent "" "" entarea)
    )
    (princ)
    )
    M.R.
    Hope this helps just for now...

  6. #6
    100 Club
    Join Date
    2006-12
    Posts
    106
    Login to Give a bone
    0

    Default Re: Need some code... Any Lispers wanna take a crack at this?

    Quote Originally Posted by marko_ribar View Post
    I have created this code according to your request... It selects LWPOLYLINES and checks them for closed option (if not closed it closes them automatically), then it hatches them with default hatch and puts text with area number in center of polyline, for it previously create region from pline and obtains its centroid where it later puts area number...

    Code:
    (defun c:areahatchpolys ( / ss ssn k ent entA entarea entreg entregA cent)
    (vl-load-com)
    (prompt "\nSelect plines")
    (setq ss (ssget (list (cons 0 "LWPOLYLINE"))))
    (setq ssn (sslength ss))
    (setq k -1)
    (repeat ssn
    (setq k (+ k 1))
    (setq ent (ssname ss k))
    (setq entA (vlax-ename->vla-object ent))
    (setq entarea (vlax-get-Property entA 'Area))
    (if (eq (vlax-get-Property entA 'Closed) :vlax-false) (vlax-put-Property entA 'Closed :vlax-true))
    (vl-cmdf "region" ent "")
    (setq entreg (entlast))
    (setq entregA (vlax-ename->vla-object entreg))
    (setq cent (vlax-safearray->list (vlax-variant-value (vlax-get-Property entregA 'Centroid))))
    (vl-cmdf "_.explode" "l" "")
    (vl-cmdf "_.pedit" "l" "" "j" "p" "" "")
    (vl-cmdf "_.bhatch" "s" (entlast) "" "")
    (vl-cmdf "_.text" cent "" "" entarea)
    )
    (princ)
    )
    M.R.
    Hope this helps just for now...
    Marko, I've run into a couple of problems with this one. First, if run on 2008 (I have one machine that I use when on the road that only has that version) it bounces out with a "no database" error. Second, when run on a virgin install of 2011, there seems to be a hangup while hatching and inserting text for the area values. As the routine runs, the first region is hatched, but then the command line shows "Command:", and then the value for the area, and hangs up, as though it is trying to call a command, but the routine is returning a numerical value, instead of some command name. Then, if I click the left mouse button, the routine proceeds to the second pline entity, hatches it, and hangs up again with the area value for the new entity showing in the command line, etc. etc. etc... No text is inserted during this process (in case that helps you).

    Maybe it's just a preference or some sysvar on my 2011 machine causing the problem, but it would also be really helpful if the routine would also run in 2008, as I cannot afford to upgrade that seat at the moment.

    I very much like the thing you added to close an open polyline. I am pretty fastidious about closing them as I create the p-lines, but when doing hundreds at a time, it's inevitable that I may miss once in a while...

    Thanks!

  7. #7
    All AUGI, all the time
    Join Date
    2015-10
    Location
    Belgrade, Serbia, Europe
    Posts
    564
    Login to Give a bone
    0

    Default Re: Need some code... Any Lispers wanna take a crack at this?

    Quote Originally Posted by crbateman View Post
    Marko, I've run into a couple of problems with this one. First, if run on 2008 (I have one machine that I use when on the road that only has that version) it bounces out with a "no database" error. Second, when run on a virgin install of 2011, there seems to be a hangup while hatching and inserting text for the area values. As the routine runs, the first region is hatched, but then the command line shows "Command:", and then the value for the area, and hangs up, as though it is trying to call a command, but the routine is returning a numerical value, instead of some command name. Then, if I click the left mouse button, the routine proceeds to the second pline entity, hatches it, and hangs up again with the area value for the new entity showing in the command line, etc. etc. etc... No text is inserted during this process (in case that helps you).

    Maybe it's just a preference or some sysvar on my 2011 machine causing the problem, but it would also be really helpful if the routine would also run in 2008, as I cannot afford to upgrade that seat at the moment.

    I very much like the thing you added to close an open polyline. I am pretty fastidious about closing them as I create the p-lines, but when doing hundreds at a time, it's inevitable that I may miss once in a while...

    Thanks!
    Strange problem you have, I have ACAD 2008, ACAD 2011, ACAD 2012, ACA 2010, ACA 2012 (Windows 7 Ultimate X64), and on all of them it works... Perhaps your installation of ACADs wasn't complete (I had on my Toshiba Laptop earlier, ACAD 2006 installed without Vlisp Acivex support, and system on that laptop was old)... I thought it's ACAD 2006 that's bad, but it seems that it could be even ACAD 2008 and ACAD 2011 as you mentioned... I don't know what advice to tell you, but to check your installation again... Maybe it could also be hardware that's bad, but I doubt in this...

    M.R.

    BTW, maybe my SVF files for ACAD 2008, and ACAD 2011 will help you, and also I'll post lisp for comparing these SVF files... If you don't want to compare them, just save them and load mine, and if it works fine, but if not then revert your originals... Command is SYSVDLG...
    Attached Files Attached Files
    Last edited by marko_ribar; 2011-03-18 at 09:22 PM. Reason: attaching files for support

  8. #8
    Administrator Opie's Avatar
    Join Date
    2002-01
    Location
    jUSt Here (a lot)
    Posts
    9,099
    Login to Give a bone
    0

    Default Re: Need some code... Any Lispers wanna take a crack at this?

    You might try this. You may have to add (vl-load-com) before it works.

    Code:
    (defun c:AHP ( / findspace SPACE PLSelection CurrentSpace CurrentPattern cntPLSelection CurrentObject CurrentHatch)
    
      ;; Get current space                     
      ;; Function developed by Peter Jamtgaard  
      (defun FINDSPACE (/ *DOC*)
        (vl-load-com)
        (setq *DOC* (vla-get-activedocument (vlax-get-acad-object)))
        (setq SPACE	(if (= 1 (vla-get-activespace *DOC*))
    		  (vla-get-modelspace *DOC*) ;we're in modelspace
    		  (if (= (vla-get-mspace *DOC*) :vlax-true)
    		    (vla-get-modelspace *DOC*) ;we're in modelspace
    					;thru paperspace VPort
    		    (vla-get-paperspace *DOC*) ;we're in paperspace
    		  )
    		)
        )
      )
      ;; Add field of area via MText
      ;; Partly taken from Tom Beauford
      ;; http://forums.augi.com/showpost.php?p=1120809&postcount=4
      (defun AddArea (Object	  /		  LowerLeftCorner
    		  UpperRightCorner		  AreaString
    		  FieldString	  PntList	  InsPoint
    		  CurrentText
    		 )
        (vla-getboundingbox
          Object
          'LowerLeftCorner
          'UpperRightCorner
        )
        (if	(vlax-property-available-p Object 'Area)
          (progn
    	(setq FieldString (strcat
    			    "%<\\AcObjProp Object(%<\\_ObjId "
    			    (itoa (vla-get-objectid object))
    			    ">%).Area \\f \"%lu2%pr0%qf1%ps[±, ft²]%th44\">%"
    			  )		; 1=1 foot
    	      PntList	  (mapcar 'vlax-safearray->list
    				  (list LowerLeftCorner UpperRightCorner)
    			  )
    	      InsPoint	  (list	(/ (+ (caar PntList) (caadr PntList)) 2.0)
    				(/ (+ (cadar PntList) (cadadr PntList)) 2.0)
    			  )
    	      CurrentText (vla-addmtext
    			    (findspace)
    			    (vlax-3d-point InsPoint)
    			    0
    			    FieldString
    			  )
    	)
          )
        )
      )
        
      ;; Main Function
      (if (progn
    	(prompt "\nSelect polylines: ")
    	(setq PLSelection    (ssget '((0 . "LWPOLYLINE,POLYLINE") (70 . 1)))
    	      CurrentSpace   (findspace)
    	      CurrentPattern (getvar 'HPNAME)
    	)
          )
        (progn
          (repeat (setq cntPLSelection (sslength PLSelection))
    	(setq CurrentObject (vlax-ename->vla-object
    			      (ssname
    				PLSelection
    				(setq cntPLSelection (1- cntPLSelection))
    			      )
    			    )
    	      CurrentArea   (vla-get-area CurrentObject)
    	)
    	(setq CurrentHatch
    	       (vla-addhatch
    		 CurrentSpace		  acHatchPatternTypePredefined
    		 CurrentPattern		  :vlax-true
    		 AcHatchObject
    		)
    	)
    	(vla-appendouterloop
    	  CurrentHatch
    	  (vlax-safearray-fill
    	    (vlax-make-safearray vlax-vbobject '(0 . 0))
    	    (list CurrentObject)
    	  )
    	)
    	(vla-put-PatternScale CurrentHatch (getvar 'HPSCALE))
    	(AddArea CurrentObject)
          )
        )
      )
    )
    If you have a technical question, please find the appropriate forum and ask it there.
    You will get a quicker response from your fellow AUGI members than if you sent it to me via a PM or email.
    jUSt

  9. #9
    100 Club
    Join Date
    2006-12
    Posts
    106
    Login to Give a bone
    0

    Default Re: Need some code... Any Lispers wanna take a crack at this?

    Quote Originally Posted by Opie View Post
    You might try this. You may have to add (vl-load-com) before it works.
    Seems to work fine, Opie (in both 2008 and 2011). Thanks!

  10. #10
    Administrator Opie's Avatar
    Join Date
    2002-01
    Location
    jUSt Here (a lot)
    Posts
    9,099
    Login to Give a bone
    0

    Default Re: Need some code... Any Lispers wanna take a crack at this?

    Quote Originally Posted by crbateman View Post
    Seems to work fine, Opie (in both 2008 and 2011). Thanks!
    You will need to set either the TEXTSIZE system variable to your desired size beforehand or add an option to specify the text size. I figured you could add that enhancement with your previous knowledge.

    Hopefully this will get you back into AutoLISP a bit more. Enjoy.
    If you have a technical question, please find the appropriate forum and ask it there.
    You will get a quicker response from your fellow AUGI members than if you sent it to me via a PM or email.
    jUSt

Page 1 of 3 123 LastLast

Similar Threads

  1. CP31-3: The AUGI® LISP Forums Greatest Hits for "Power LISPers"
    By Autodesk University in forum Customization and Programming
    Replies: 0
    Last Post: 2013-04-10, 02:28 AM
  2. RC Crack width calculation output in robot
    By noblegavin132146 in forum Robot Structural Analysis
    Replies: 0
    Last Post: 2011-12-21, 11:55 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •