Author Topic: Can you me Help me Speed up this code?  (Read 7144 times)

0 Members and 1 Guest are viewing this topic.

cmwade77

  • Swamp Rat
  • Posts: 1443
Can you me Help me Speed up this code?
« on: August 29, 2011, 01:27:04 PM »
Ok, so I am working on some code that modifies a table based on points picked. I need some advice on how to speed up the code, right now it is painstakingly slow, which kind of defeates the whole point of the routine.

Please note that the code is part of a larger routine, so the error handling and localization of variables is not handled in the code below, but it should be good enough to get some help in speeding it up, I hope. The rest of the code still has some major bugs, which I am working through, so I don't want to post it yet, as it can cause AutoCAD to crash.

Code: [Select]
(defun c:mt ()
(setq Pt1 (getpoint "\nGet first point of crossing: ")
         Pt2 (getcorner Pt1 "\nGet second point of crossing: ")
         SS (ssget "_C" Pt1 Pt2 '((0 . "ACAD_TABLE"))
)
(while (setq Ent (ssname SS 0))
     (ModifyTable Pt1 Pt2 "TESTING" (vlax-ename->vla-object Ent))
     (ssdel (ssname SS 0) SS)
)
)
(defun ModifyTable (Pt1 Pt2 Text Object)
(setq Rows (vla-get-rows Object)
  Columns (vla-get-columns Object)
  xMin (min (car Pt1) (car Pt2))
  xMax (max (car Pt1) (car Pt2))
  yMin (min (cadr Pt1) (cadr Pt2))
  yMax (max (cadr Pt1) (cadr Pt2))
  LowerLeft1 (list xMin yMin)
  UpperRight1 (list xMax yMax)
  Pick1 LowerLeft1
  Row 0
  Column 0
)
(while (< Column (- Columns 1))
(while (< Row (- Rows 1))
(setq Pick2 (vlax-safearray->list (vlax-variant-value (vla-getcellextents Object Row Column 0)))
  Pt3 (list (nth 0 Pick2) (nth 1 Pick2))
  Pt4 (list (nth 9 Pick2) (nth 10 Pick2))
  LowerLeft2 (list (car Pt3) (car Pt4))
  UpperRight2 (list (car Pt4) (cadr Pt3))
  Pick (ct_mid Pt3 Pt4)
)
(cond
((and (or (<= (car LowerLeft1) (car LowerLeft2) (car UpperRight1)) (<= (car LowerLeft1) (car UpperRight2) (car UpperRight1))) (or (<= (cadr LowerLeft1) (cadr LowerLeft2) (cadr UpperRight1)) (<= (cadr LowerLeft1) (cadr UpperRight2) (cadr UpperRight1))))
(vlax-invoke-method Object 'SetText Row Col Text)
(vlax-invoke-method Object 'Update)
)
)
(setq Row (+ Row 1))
)
(setq Column (+ Column 1)
  Row 0
)
)
)

Jeff_M

  • King Gator
  • Posts: 4087
  • C3D user & customizer
Re: Can you me Help me Speed up this code?
« Reply #1 on: August 29, 2011, 01:50:59 PM »
I didn't see that you were using this, which greatly enhances performance when editing tables:
Code: [Select]
(vla-put-RegenerateTableSuppressed table :vlax-true);;don't regen table with every addition/change

;;;;make all of the changes

(vla-put-RegenerateTableSuppressed table :vlax-false)

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: Can you me Help me Speed up this code?
« Reply #2 on: August 29, 2011, 02:06:19 PM »
Thank you, that does speed it up a fair amount.

There appears to also be some speed (and accuracy issues) with figuring out if the cell is within the crossing box or not. Any ideas on that? I have the cell extents and the crossing box points, as you can see, so hopefully someone can help speed that up as well.

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
Re: Can you me Help me Speed up this code?
« Reply #3 on: August 29, 2011, 02:15:44 PM »
This thread may help, from this message onwards:

http://www.theswamp.org/index.php?topic=37154.msg421627#msg421627

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: Can you me Help me Speed up this code?
« Reply #4 on: August 29, 2011, 02:26:14 PM »
This thread may help, from this message onwards:

http://www.theswamp.org/index.php?topic=37154.msg421627#msg421627
Lee, while this definitely will come in handy in the future, I don't see how I could use it to determine if the cells are within a set of coordinates.

For example do the coordinates ((0,0) (10,10)) cross ((3,3) (18,18))? (In this example they would indeed, but what I need to do is test for this from a programming viewpoint or be able to select only the cells that are within the original coordinates)

It appears that the vla-setsubselection requires cell numbers, not coordinates.

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
Re: Can you me Help me Speed up this code?
« Reply #5 on: August 29, 2011, 02:41:22 PM »
I thought you might use it in place of your window point prompts - i.e. the user selects the table cells, then you use getsubselection to obtain the selected cell range.

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Can you me Help me Speed up this code?
« Reply #6 on: August 29, 2011, 02:46:40 PM »
Minor adjustment :
faster then this :
Code: [Select]
(while (setq Ent (ssname SS 0))
     (ModifyTable Pt1 Pt2 "TESTING" (vlax-ename->vla-object Ent))
     (ssdel (ssname SS 0) SS)
)
is this:
Code: [Select]
(repeat (setq i (sslength ss))
     (setq i (1- i))
     (setq Ent (ssname ss i))
     (ModifyTable Pt1 Pt2 "TESTING" (vlax-ename->vla-object Ent))
)

M.R.
This way tables are processed from first to last one - (ssname ss 0) without deleting last one from ss and reordering entities from ss to match that ssdel removal. You'll keep ss during routine execution this way, but you can localize ss variable in main routine, so after execution of main routine, ss would be reset to nil...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: Can you me Help me Speed up this code?
« Reply #7 on: August 29, 2011, 02:57:41 PM »
I thought you might use it in place of your window point prompts - i.e. the user selects the table cells, then you use getsubselection to obtain the selected cell range.
Interesting idea, unfortunately, due to how the remainder of the code works, this isn't really an option. I have removed the bugs that had me concerned about stability, so here is the entire code:
Code: [Select]
;*****************************************************************************************************************************************
; CopyText **
; Written by: Chris Wade **
;        Version 3.0 **
;             **
; - Bugs: Updating Tables still does not work 100% correctly.         **
;   Not all features have been added back in yet.             **
;                           **
;*****************************************************************************************************************************************
; Credits: **
; - Original code for modifying tables: Lee Abrosius - 03/24/04 **
; - Original code for crossing box from Kent1Cooper at http://discussion.autodesk.com/forums/thread.jspa?threadID=761481&tstart=0 **
; - Original code for processing MLeaders with Blocks from Lee Mac @ TheSwamp.org, CADTutor.net Copyright © 2010 by Lee McDonnell **
;      - This code has been heavily modified for use within this routine.             **
; If you recognize any of your code, please let me know by sending me a PM at http://www.theswamp.org - cmwade77          **
;*****************************************************************************************************************************************
(defun c:ct (/ Text StopLoop Input Data Code Pt1 Pt2 Formatting Ent Filter SS)
(vl-load-com)
;Supporting Functions
(defun ct_GetText (/ Str Text StopLoop Input Data Code Pick vHeight vWidth lwrLeft uprRight vector SS Table TableEnt Row Col Ent Object ObjectName ObjectBlock AttList Att Pt1 Pt2 TestPt1 XMIN XMAX YMIN YMAX InsPt1)
(setq Text "")
(cond
((= OldValue nil)
(setq OldValue ".")
)
)
(princ (strcat "\rSelect text to copy or type text <" OldValue ">: "))
(while (not StopLoop)
(setq Input (grread T 4 2)
  Data (cadr Input)
  Code (car Input)
)
(cond
((= Code 3)
(setq Pick (vlax-3d-point Data))
(cond
(Pick
(setq vHeight (getvar "viewsize")
  vWidth (* (/ (nth 0 (getvar "screensize")) (nth 1 (getvar "screensize"))) vHeight)
  lwrLeft (list (- (nth 0 (getvar "viewctr")) (/ vWidth 2)) (- (nth 1 (getvar "viewctr")) (/ vHeight 2)) 0)
  uprRight (list (+ (nth 0 (getvar "viewctr")) (/ vWidth 2)) (+ (nth 1 (getvar "viewctr")) (/ vHeight 2)) 0)
  vector (vlax-make-safearray vlax-vbDouble '(0 . 2))
)
(vlax-safearray-fill vector '(1 1 1))
(setq vector (vlax-make-variant vector))
(cond ; Check to see if selected point was on a Table
((setq SS (ssget "C" lwrleft uprRight (list (cons 0 "ACAD_TABLE"))))
(while (and (setq TableEnt (ssname SS 0)) (not StopLoop))
(setq Table (vlax-ename->vla-object TableEnt)
  Row 0
  Col 0
)
(cond
((= (vla-hittest Table Pick vector 'Row 'Col) :vlax-true)
(setq Text (vlax-invoke-method Table 'GetText Row Col)
  StopLoop T
)
)
)
(ssdel (ssname SS 0) SS)
)
)
)
(cond ; If a table was not selected, do the following
((or (not Text) (= Text ""))
(setq Ent (nentselp "" Data))
(cond
(Ent
(setq Object (vlax-ename->vla-object (car Ent))
  ObjectType (vla-get-ObjectName Object)
)
(cond
((= ObjectType "AcDbMLeader")
(cond
((/= (vla-get-contenttype Object) 1)
(setq Text (vla-get-textstring Object)
  StopLoop T
)
)
(T
(defun LM:Itemp ( coll item )
;; © Lee Mac 2010
(if
(not
(vl-catch-all-error-p
(setq item
(vl-catch-all-apply
(function vla-item) (list coll item)
)
)
)
)
item
)
)
(setq AttList (LM:Itemp (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-get-ContentBlockName Object))
  InsPt1 (cdr (assoc 15 (entget (car Ent))))
)
(vlax-for Att AttList
(cond
((= (vla-get-objectname Att) "AcDbAttributeDefinition")
(setq  Pt1 (polar Data (* pi (/ 45 180.0)) 0.13)
   pt2 (polar Data (* pi (/ 225 180.0)) 0.13)
   TestPt1 (polar (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint Att))) (angle '(0 0 0) InsPt1) (distance '(0 0 0) InsPt1))
   XMIN (MIN (CAR Pt1)(CAR pt2))
   XMAX (MAX (CAR Pt1)(CAR pt2))
   YMIN (MIN (CADR Pt1)(CADR pt2))
   YMAX (MAX (CADR Pt1)(CADR pt2))
)
(cond
((and (< XMIN (CAR TestPt1))(> XMAX (CAR TestPt1)) (< YMIN (CADR TestPt1))(> YMAX (CADR TestPt1)))
(setq Text (vla-GetBlockAttributeValue Object (vla-get-ObjectID Att))
  StopLoop T
)
)
)
)
)
)
)
)
)
((or (wcmatch ObjectType "*Text*") (wcmatch ObjectType "*Dimension*"))
(setq Text (vla-get-textstring Object)
  StopLoop T
)
)
)
)
)
)
)
)
)
)
((= Code 2)
(if (not Str) (setq Str ""))
(cond
((<= 32 Data)
(setq Str (strcat Str (princ (chr Data))))
)
((and (> (strlen Str) 0) (= Data 8))
(setq Str (Substr Str 1 (- (strlen Str) 1)))
(princ (vl-list->string '(8 32 8)))
)
((= Data 13)
(setq Text Str
  StopLoop T
)
)
)
)
((= Code 25)
(cond
((and Str (/= Str ""))
(setq Text Str)
)
)
(setq StopLoop T)
)
)
)
(cond
((or (not Text) (= Text ""))
(setq Text OldValue)
)
(T
(setq OldValue Text)
)
)
Text
)
(defun ct_SetText (Ent Text Pt1 Pt2 Formatting / Att AttList Pt3 Pt4 Object ObjectType Rows Columns cRow cColumn XMIN XMAX YMIN YMAX Pick LowerLeft1 UpperRight1 LowerLeft2 UpperRight2 Pick1 Pick2 TestPt1)
;ct_SetText Supporting Functions
(defun ct_ChangeTable (Pick Text Table / vHeight vWidth LwrLeft Uprright vector Ent2 Table Row Col StopLoop)
(setq vHeight (getvar "viewsize")
  vWidth (* (/ (nth 0 (getvar "screensize")) (nth 1 (getvar "screensize"))) vHeight)
  lwrLeft (list (- (nth 0 (getvar "viewctr")) (/ vWidth 2)) (- (nth 1 (getvar "viewctr")) (/ vHeight 2)) 0)
  uprRight (list (+ (nth 0 (getvar "viewctr")) (/ vWidth 2)) (+ (nth 1 (getvar "viewctr")) (/ vHeight 2)) 0)
  vector (vlax-make-safearray vlax-vbDouble '(0 . 2))
  )
  (vlax-safearray-fill vector '(1 1 1))
  (setq vector (vlax-make-variant vector))
(setq Row 0
  Col 0
)
(cond
((= (vla-hittest Table Pick Vector 'Row 'Col) :vlax-true)
(cond
((= (vlax-invoke-method Table 'GetCellType Row Col) acTextCell)
(vlax-invoke-method Table 'SetText Row Col Text)
(vlax-invoke-method Table 'Update)
)
)
)
)
)
(defun ct_Mid (pt1 pt2)
(mapcar '(lambda (x y) (* 0.5 (+ x y))) pt1 pt2)
)
;End of Supporting Functions
(setq Object (vlax-ename->vla-object Ent)
  ObjectType (vla-get-ObjectName Object)
)
(cond
((= ObjectType "AcDbTable")
(vla-put-RegenerateTableSuppressed Object :vlax-true)
(setq Rows (vla-get-rows Object)
  Columns (vla-get-columns Object)
  xMin (min (car Pt1) (car Pt2))
  xMax (max (car Pt1) (car Pt2))
  yMin (min (cadr Pt1) (cadr Pt2))
  yMax (max (cadr Pt1) (cadr Pt2))
  LowerLeft1 (list xMin yMin)
  UpperRight1 (list xMax yMax)
  Pick1 LowerLeft1
  Row 0
  Column 0
)
(while (< Column (- Columns 1))
(while (< Row (- Rows 1))
(setq Pick2 (vlax-safearray->list (vlax-variant-value (vla-getcellextents Object Row Column 0)))
  Pt3 (list (nth 0 Pick2) (nth 1 Pick2))
  Pt4 (list (nth 9 Pick2) (nth 10 Pick2))
  LowerLeft2 (list (car Pt3) (car Pt4))
  UpperRight2 (list (car Pt4) (cadr Pt3))
  Pick (ct_mid Pt3 Pt4)
)
(cond
((and (or (<= (car LowerLeft1) (car LowerLeft2) (car UpperRight1)) (<= (car LowerLeft1) (car UpperRight2) (car UpperRight1))) (or (<= (cadr LowerLeft1) (cadr LowerLeft2) (cadr UpperRight1)) (<= (cadr LowerLeft1) (cadr UpperRight2) (cadr UpperRight1))))
(ct_ChangeTable (vlax-3d-point Pick) Text Object)
)
)
(setq Row (+ Row 1))
)
(setq Column (+ Column 1)
  Row 0
)
)
(vla-put-RegenerateTableSuppressed Object :vlax-false)
)
((= ObjectType "AcDbBlockReference")
(setq XMIN (MIN (CAR pt1)(CAR pt2))
  XMAX (MAX (CAR pt1)(CAR pt2))
  YMIN (MIN (CADR pt1)(CADR pt2))
  YMAX (MAX (CADR pt1)(CADR pt2))
  AttList (vlax-safearray->list (vlax-variant-value (vla-getattributes Object)))
)
(foreach Att AttList
(setq TestPt1 (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint Att))))
(cond
((and (< XMIN (CAR TestPt1))(> XMAX (CAR TestPt1)) (< YMIN (CADR TestPt1))(> YMAX (CADR TestPt1)))
(vla-put-textstring att text)
)
)
)
)
((= ObjectType "AcDbMLeader")
;(alert "works")
(cond
((= (vla-get-contenttype Object) 1)
(defun LM:Itemp ( coll item )
;; © Lee Mac 2010
(if
(not
(vl-catch-all-error-p
(setq item
(vl-catch-all-apply
(function vla-item) (list coll item)
)
)
)
)
item
)
)
(setq AttList (LM:Itemp (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-get-ContentBlockName Object))
  InsPt1 (cdr (assoc 15 (entget Ent)))
  )
(vlax-for Att AttList
(cond
((= (vla-get-objectname Att) "AcDbAttributeDefinition")
(setq  mlPt1 (polar Pt1 (* pi (/ 45 180.0)) 0.13)
   mlpt2 (polar Pt2 (* pi (/ 225 180.0)) 0.13)
   TestPt1 (polar (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint Att))) (angle '(0 0 0) InsPt1) (distance '(0 0 0) InsPt1))
   XMIN (MIN (CAR mlPt1)(CAR mlpt2))
   XMAX (MAX (CAR mlPt1)(CAR mlpt2))
   YMIN (MIN (CADR mlPt1)(CADR mlpt2))
   YMAX (MAX (CADR mlPt1)(CADR mlpt2))
)
(cond
((and (< XMIN (CAR TestPt1))(> XMAX (CAR TestPt1)) (< YMIN (CADR TestPt1))(> YMAX (CADR TestPt1)))
(vla-SetBlockAttributeValue Object (vla-get-ObjectID Att) Text)
)
)
)
)
)
)
(T
(vla-put-textstring Object Text)
)
)
)
((wcmatch ObjectType "*Dimension*")
(vla-put-textoverride Object Text)
)
(T
(vla-put-textstring Object Text)
)
)
)
;End Supporting functions
(setq Text (ct_GetText))
(while (not StopLoop)
(princ "\rSelect text to copy to: ")
(setq Input (grread T 4 2)
  Data (cadr Input)
  Code (car Input)
  )
(cond
((= Code 3)
(setq Pt1 Data
  Ent (nentselp "" Pt1))
(cond
(Ent ; If Object is selected, run this
(ct_SetText (car Ent) Text Pt1 Pt1 Formatting)
)
(T ; If blank space is selected, run this
(setq Pt2 (getcorner Pt1 "\rSelect opposite corner of crossing box: "))
(cond
(Pt2
(setq Filter '((-4 . "<OR") (0 . "TEXT") (0 . "MULTILEADER") (0 . "ACAD_TABLE") (0 . "*DIMENSION*") (0 . "MTEXT") (-4 . "<AND") (0 . "INSERT") (66 . 1) (-4 . "AND>") (-4 . "OR>"))
  SS (ssget "_C" Pt1 Pt2 Filter)
)
(while (setq Ent (ssname SS 0))
(ct_SetText (ssname SS 0) Text Pt1 Pt2 Formatting)
(ssdel (ssname SS 0) SS)
)
)
)
)
)
)
)
)
)

This code is a rewrite of my copy text routine (there were numerous bugs in it and it had become just a mush of code from various sources, so a rewrite was in order). That being said, I do need to use the crossing method as a result. Unless I can find a way to select the cells based on points.

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Can you me Help me Speed up this code?
« Reply #8 on: August 30, 2011, 09:14:50 AM »
Here, I modified it... I hope this is what you wanted...

Code: [Select]
;*****************************************************************************************************************************************
; CopyText **
; Written by: Chris Wade **
;        Version 3.0 **
;             **
; - Bugs: Updating Tables still does not work 100% correctly.         **
;   Not all features have been added back in yet.             **
;                           **
;*****************************************************************************************************************************************
; Credits: **
; - Original code for modifying tables: Lee Abrosius - 03/24/04 **
; - Original code for crossing box from Kent1Cooper at http://discussion.autodesk.com/forums/thread.jspa?threadID=761481&tstart=0 **
; - Original code for processing MLeaders with Blocks from Lee Mac @ TheSwamp.org, CADTutor.net Copyright © 2010 by Lee McDonnell **
;      - This code has been heavily modified for use within this routine.             **
; If you recognize any of your code, please let me know by sending me a PM at http://www.theswamp.org - cmwade77          **
;*****************************************************************************************************************************************
(defun c:ct (/ Text StopLoop Input Data Code Pt1 Pt2 Formatting Ent Filter SS i)
(vl-load-com)
        ;Supporting Functions
(defun ct_GetText (/ Str Text StopLoop Input Data Code Pick vHeight vWidth lwrLeft uprRight vector SS Table TableEnt Row Col Ent Object ObjectName ObjectBlock AttList Att Pt1 Pt2 TestPt1 XMIN XMAX YMIN YMAX InsPt1 i)
(setq Text "")
(cond
((= OldValue nil)
(setq OldValue ".")
)
)
(princ (strcat "\rSelect text to copy <ENTER> or type text <" OldValue ">: "))
  (setq Text (getstring T))
  (if (= Text "")
(progn
(while (not StopLoop)
(setq Input (grread T 4 2)
  Data (cadr Input)
  Code (car Input)
)
(cond
((= Code 3)
(setq Pick (vlax-3d-point Data))
))
(cond
(Pick
(setq vHeight (getvar "viewsize")
  vWidth (* (/ (nth 0 (getvar "screensize")) (nth 1 (getvar "screensize"))) vHeight)
  lwrLeft (list (- (nth 0 (getvar "viewctr")) (/ vWidth 2)) (- (nth 1 (getvar "viewctr")) (/ vHeight 2)) 0)
  uprRight (list (+ (nth 0 (getvar "viewctr")) (/ vWidth 2)) (+ (nth 1 (getvar "viewctr")) (/ vHeight 2)) 0)
  vector (vlax-make-safearray vlax-vbDouble '(0 . 2))
)
(vlax-safearray-fill vector '(1 1 1))
(setq vector (vlax-make-variant vector))
(cond ; Check to see if selected point was on a Table
(T (progn (setq SS (ssget Data '((0 . "ACAD_TABLE"))) i (if SS (sslength SS) 0))
(while (and (< 0 i) (not StopLoop))
(setq TableEnt (ssname SS (setq i (1- i))))
(setq Table (vlax-ename->vla-object TableEnt)
  Row 0
  Col 0
)
(cond
((= (vla-hittest Table Pick vector 'Row 'Col) :vlax-true)
(setq Text (vlax-invoke-method Table 'GetText Row Col)
  StopLoop T
)
)
)
))
)
)
(cond ; If a table was not selected, do the following
((or (not Text) (= Text ""))
(setq Ent (nentselp "" Data))
(cond
(Ent
(setq Object (vlax-ename->vla-object (car Ent))
  ObjectType (vla-get-ObjectName Object)
)
(cond
((= ObjectType "AcDbMLeader")
(cond
((/= (vla-get-contenttype Object) 1)
(setq Text (vla-get-textstring Object)
  StopLoop T
)
)
(T (defun LM:Itemp ( coll item )
;; © Lee Mac 2010
(if
(not
(vl-catch-all-error-p
(setq item
(vl-catch-all-apply
(function vla-item) (list coll item)
)
)
)
)
item
)
)
(setq AttList (LM:Itemp (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-get-ContentBlockName Object))
  InsPt1 (cdr (assoc 15 (entget (car Ent))))
)
(vlax-for Att AttList
(cond
((= (vla-get-objectname Att) "AcDbAttributeDefinition")
(setq  Pt1 (polar Data (* pi (/ 45 180.0)) 0.13)
   pt2 (polar Data (* pi (/ 225 180.0)) 0.13)
   TestPt1 (polar (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint Att))) (angle '(0 0 0) InsPt1) (distance '(0 0 0) InsPt1))
   XMIN (MIN (CAR Pt1)(CAR pt2))
   XMAX (MAX (CAR Pt1)(CAR pt2))
   YMIN (MIN (CADR Pt1)(CADR pt2))
   YMAX (MAX (CADR Pt1)(CADR pt2))
)
(cond
((and (< XMIN (CAR TestPt1))(> XMAX (CAR TestPt1)) (< YMIN (CADR TestPt1))(> YMAX (CADR TestPt1)))
(setq Text (vla-GetBlockAttributeValue Object (vla-get-ObjectID Att))
  StopLoop T
)
)
)
)
)
)
)
)
)
((or (wcmatch ObjectType "*Text*") (wcmatch ObjectType "*Dimension*"))
(setq Text (vla-get-textstring Object)
  StopLoop T
)
)
)
)
)
)
)
)
((= Code 2)
(if (not Str) (setq Str ""))
(cond
((<= 32 Code)
(setq Str (strcat Str (princ (chr Code))))
)
((and (> (strlen Str) 0) (= Code 8))
(setq Str (Substr Str 1 (- (strlen Str) 1)))
(princ (vl-list->string '(8 32 8)))
)
((= Code 13)
(setq Text Str
  StopLoop T
)
)
)
)
((= Code 25)
(cond
((and Str (/= Str ""))
(setq Text Str)
)
)
(setq StopLoop T)
)
)
)
))
(cond
((or (not Text) (= Text ""))
(setq Text OldValue)
)
(T
(setq OldValue Text)
)
)
Text
)
(defun ct_SetText (Ent Text Pt1 Pt2 Formatting / Att AttList Pt3 Pt4 Object ObjectType Rows Columns cRow cColumn XMIN XMAX YMIN YMAX Pick LowerLeft1 UpperRight1 LowerLeft2 UpperRight2 Pick1 Pick2 TestPt1)
;ct_SetText Supporting Functions
(defun ct_ChangeTable (Pick Text Table / vHeight vWidth LwrLeft Uprright vector Ent2 Table Row Col StopLoop)
(setq vHeight (getvar "viewsize")
  vWidth (* (/ (nth 0 (getvar "screensize")) (nth 1 (getvar "screensize"))) vHeight)
  lwrLeft (list (- (nth 0 (getvar "viewctr")) (/ vWidth 2)) (- (nth 1 (getvar "viewctr")) (/ vHeight 2)) 0)
  uprRight (list (+ (nth 0 (getvar "viewctr")) (/ vWidth 2)) (+ (nth 1 (getvar "viewctr")) (/ vHeight 2)) 0)
  vector (vlax-make-safearray vlax-vbDouble '(0 . 2))
  )
  (vlax-safearray-fill vector '(1 1 1))
  (setq vector (vlax-make-variant vector))
(setq Row 0
  Col 0
)
(cond
((= (vla-hittest Table Pick Vector 'Row 'Col) :vlax-true)
(cond
((= (vlax-invoke-method Table 'GetCellType Row Col) acTextCell)
(vlax-invoke-method Table 'SetText Row Col Text)
(vlax-invoke-method Table 'Update)
)
)
)
)
)
(defun ct_Mid (pt1 pt2)
(mapcar '(lambda (x y) (* 0.5 (+ x y))) pt1 pt2)
)
;End of Supporting Functions
(setq Object (vlax-ename->vla-object Ent)
  ObjectType (vla-get-ObjectName Object)
)
(cond
((= ObjectType "AcDbTable")
(vla-put-RegenerateTableSuppressed Object :vlax-true)
(setq Rows (vla-get-rows Object)
  Columns (vla-get-columns Object)
  xMin (min (car Pt1) (car Pt2))
  xMax (max (car Pt1) (car Pt2))
  yMin (min (cadr Pt1) (cadr Pt2))
  yMax (max (cadr Pt1) (cadr Pt2))
  LowerLeft1 (list xMin yMin)
  UpperRight1 (list xMax yMax)
  Pick1 LowerLeft1
  Row 0
  Column 0
)
(while (< Column Columns)
(while (< Row Rows)
(setq Pick2 (vlax-safearray->list (vlax-variant-value (vla-getcellextents Object Row Column 0)))
  Pt3 (list (nth 0 Pick2) (nth 1 Pick2))
  Pt4 (list (nth 9 Pick2) (nth 10 Pick2))
  LowerLeft2 (list (car Pt3) (car Pt4))
  UpperRight2 (list (car Pt4) (cadr Pt3))
  Pick (ct_mid Pt3 Pt4)
)
(cond
((and (or (<= (car LowerLeft1) (car LowerLeft2) (car UpperRight1)) (<= (car LowerLeft1) (car UpperRight2) (car UpperRight1))) (or (<= (cadr LowerLeft1) (cadr LowerLeft2) (cadr UpperRight1)) (<= (cadr LowerLeft1) (cadr UpperRight2) (cadr UpperRight1))))
(ct_ChangeTable (vlax-3d-point Pick) Text Object)
)
)
(setq Row (+ Row 1))
)
(setq Column (+ Column 1)
  Row 0
)
)
(vla-put-RegenerateTableSuppressed Object :vlax-false)
)
((= ObjectType "AcDbBlockReference")
(setq XMIN (MIN (CAR pt1)(CAR pt2))
  XMAX (MAX (CAR pt1)(CAR pt2))
  YMIN (MIN (CADR pt1)(CADR pt2))
  YMAX (MAX (CADR pt1)(CADR pt2))
  AttList (vlax-safearray->list (vlax-variant-value (vla-getattributes Object)))
)
(foreach Att AttList
(setq TestPt1 (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint Att))))
(cond
((and (< XMIN (CAR TestPt1))(> XMAX (CAR TestPt1)) (< YMIN (CADR TestPt1))(> YMAX (CADR TestPt1)))
(vla-put-textstring att text)
)
)
)
)
((= ObjectType "AcDbMLeader")
;(alert "works")
(cond
((= (vla-get-contenttype Object) 1)
(defun LM:Itemp ( coll item )
;; © Lee Mac 2010
(if
(not
(vl-catch-all-error-p
(setq item
(vl-catch-all-apply
(function vla-item) (list coll item)
)
)
)
)
item
)
)
(setq AttList (LM:Itemp (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-get-ContentBlockName Object))
  InsPt1 (cdr (assoc 15 (entget Ent)))
  )
(vlax-for Att AttList
(cond
((= (vla-get-objectname Att) "AcDbAttributeDefinition")
(setq  mlPt1 (polar Pt1 (* pi (/ 45 180.0)) 0.13)
   mlpt2 (polar Pt2 (* pi (/ 225 180.0)) 0.13)
   TestPt1 (polar (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint Att))) (angle '(0 0 0) InsPt1) (distance '(0 0 0) InsPt1))
   XMIN (MIN (CAR mlPt1)(CAR mlpt2))
   XMAX (MAX (CAR mlPt1)(CAR mlpt2))
   YMIN (MIN (CADR mlPt1)(CADR mlpt2))
   YMAX (MAX (CADR mlPt1)(CADR mlpt2))
)
(cond
((and (< XMIN (CAR TestPt1))(> XMAX (CAR TestPt1)) (< YMIN (CADR TestPt1))(> YMAX (CADR TestPt1)))
(vla-SetBlockAttributeValue Object (vla-get-ObjectID Att) Text)
)
)
)
)
)
)
(T
(vla-put-textstring Object Text)
)
)
)
((wcmatch ObjectType "*Dimension*")
(vla-put-textoverride Object Text)
)
((wcmatch ObjectType "*Text*")
(vla-put-textstring Object Text)
)
)
)
;End Supporting functions
(setq Text (ct_GetText))
(while (not StopLoop)
(princ "\rSelect text to copy to: ")
(setq Input (grread T 4 2)
  Data (cadr Input)
  Code (car Input)
  )
(cond
((= Code 3)
(setq Pt1 Data
Ent (nentselp "" Pt1))
(cond
(Ent ; If Object is selected, run this
(ct_SetText (car Ent) Text Pt1 Pt1 Formatting)
)
(T ; If blank space is selected, run this
(setq Pt2 (getcorner Pt1 "\rSelect opposite corner of crossing box: "))
(cond
(Pt2
(setq Filter '((-4 . "<OR") (0 . "TEXT") (0 . "MULTILEADER") (0 . "ACAD_TABLE") (0 . "*DIMENSION*") (0 . "MTEXT") (-4 . "<AND") (0 . "INSERT") (66 . 1) (-4 . "AND>") (-4 . "OR>"))
  SS (ssget "_C" Pt1 Pt2 Filter)
)
(repeat (setq i (if SS (sslength SS) 0))
(setq Ent (ssname SS (setq i (1- i))))
(ct_SetText Ent Text Pt1 Pt2 Formatting)
)
(if (= i 0)
  (progn
  (setq StopLoop T)
(princ)
)
)
)
)
)
)
)
)
)
)

Regards, M.R. :kewl:
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

BlackBox

  • King Gator
  • Posts: 3770
Re: Can you me Help me Speed up this code?
« Reply #9 on: August 30, 2011, 09:29:33 AM »
Minor adjustment :
faster then this :
Code: [Select]
(while (setq Ent (ssname SS 0))
     (ModifyTable Pt1 Pt2 "TESTING" (vlax-ename->vla-object Ent))
     (ssdel (ssname SS 0) SS)
)
is this:
Code: [Select]
(repeat (setq i (sslength ss))
     (setq i (1- i))
     (setq Ent (ssname ss i))
     (ModifyTable Pt1 Pt2 "TESTING" (vlax-ename->vla-object Ent))
)

M.R.
This way tables are processed from first to last one - (ssname ss 0) without deleting last one from ss and reordering entities from ss to match that ssdel removal. You'll keep ss during routine execution this way, but you can localize ss variable in main routine, so after execution of main routine, ss would be reset to nil...

Faster still:

Code: [Select]
((lambda (i / e)
   (while (setq e (ssname ss (setq i (1+ i))))
     (ModifyTable pt1 pt2 "TESTING" (vlax-ename->vla-object e))))
  -1)
"How we think determines what we do, and what we do determines what we get."

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
Re: Can you me Help me Speed up this code?
« Reply #10 on: August 30, 2011, 09:43:31 AM »

faster .. is this:
Code: [Select]
(repeat (setq i (sslength ss))
     (setq i (1- i))
...
)

Faster still:
Code: [Select]
((lambda (i / e)
   (while (setq e (ssname ss (setq i (1+ i))))
...
  -1)

6 of one, half-a-dozen of the other I think...

Code: [Select]
(defun while:ss->lst ( ss / i l )
  (setq i -1)
  (while (setq e (ssname ss (setq i (1+ i))))
    (setq l (cons e l))
  )
  l
)

(defun repeat:ss->lst ( ss / i l )
  (repeat (setq i (sslength ss))
    (setq l (cons (ssname ss (setq i (1- i))) l))
  )
  l
)

Un-"compiled":

Code: [Select]
SSLength: 10000
Elapsed milliseconds / relative speed for 64 iteration(s):

    (WHILE:SS->LST SS)......1420 / 1.42 <fastest>
    (REPEAT:SS->LST SS).....2012 / 1 <slowest>

"compiled":

Code: [Select]
SSLength: 10000
Elapsed milliseconds / relative speed for 512 iteration(s):

    (REPEAT:SS->LST SS).....1482 / 1.11 <fastest>
    (WHILE:SS->LST SS)......1638 / 1 <slowest>

 :-)

BlackBox

  • King Gator
  • Posts: 3770
Re: Can you me Help me Speed up this code?
« Reply #11 on: August 30, 2011, 10:10:20 AM »
Interesting....

*Slight* modification:

Code: [Select]
(defun while:ss->lst ( / ss i e l )
  (setq ss (ssget "_x"))
  (setq i -1)
  (while (setq e (ssname ss (setq i (1+ i))))
    (setq l (cons e l))
  )
  l
)

(defun lambda+while:ss->lst ( / l)
  ((lambda (i ss / e)
     (while (setq e (ssname ss (setq i (1+ i))))
       (setq l (cons e l))
       ))
    -1
    (ssget "_x")
    )
  l
)

(defun repeat:ss->lst ( / ss i l )
  (repeat (setq i (sslength (setq ss (ssget "_x"))))
    (setq l (cons (ssname ss (setq i (1- i))) l))
  )
  l
)

Uncompiled:

Code: [Select]
Command: (bench '(while:ss->lst lambda+while:ss->lst repeat:ss->lst) '() 10000)

WHILE:SS->LST
Elapsed: 10453
Average: 1.0453

LAMBDA+WHILE:SS->LST
Elapsed: 10437
Average: 1.0437

REPEAT:SS->LST
Elapsed: 11030
Average: 1.1030

Edit: Forgot to mention, ss = array of 100 circles.

Edit: Bench.lsp attached.
« Last Edit: August 30, 2011, 10:15:58 AM by RenderMan »
"How we think determines what we do, and what we do determines what we get."

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: Can you me Help me Speed up this code?
« Reply #12 on: August 30, 2011, 07:24:13 PM »
Ok, I think I have it working, now I would like someone to help me break it:

Code: [Select]
;*****************************************************************************************************************************************
; CopyText **
; Written by: Chris Wade **
;        Version 3.0 **
;             **
; - Bugs: Updating Tables are still slower than I would like.         **
;                           **
;*****************************************************************************************************************************************
; Credits: **
; - Original code for modifying tables: Lee Abrosius - 03/24/04 **
; - Original code for crossing box from Kent1Cooper at http://discussion.autodesk.com/forums/thread.jspa?threadID=761481&tstart=0 **
; - Original code for processing MLeaders with Blocks from Lee Mac @ TheSwamp.org, CADTutor.net Copyright © 2010 by Lee McDonnell **
;      - This code has been heavily modified for use within this routine.             **
; - Code for Math functions by Lee Mac @ TheSwamp.org, CADTutor.net Copyright © Lee McDonnell, April 2010           **
; If you recognize any of your code, please let me know by sending me a PM at http://www.theswamp.org - cmwade77          **
;*****************************************************************************************************************************************
(defun c:ct (/ Msg Text StopLoop Input Data Code Pt1 Pt2 Formatting Ent Filter SS Increment Math Order)
(vl-load-com)
;Supporting Functions
(defun ct_Crossing (Pt1 Text Formatting Increment Math Order / Pt2 Filter SS)
(setq Pt2 (getcorner Pt1 "\rSelect opposite corner of crossing box: "))
(cond
(Pt2
(setq Filter '((-4 . "<OR") (0 . "TEXT") (0 . "MULTILEADER") (0 . "ACAD_TABLE") (0 . "*DIMENSION*") (0 . "MTEXT") (-4 . "<AND") (0 . "INSERT") (66 . 1) (-4 . "AND>") (-4 . "OR>"))
  SS (ssget "_C" Pt1 Pt2 Filter)
)
(while (setq Ent (ssname SS 0))
(ct_SetText (ssname SS 0) Text Pt1 Pt2 Formatting)
(cond
(Increment
(setq Text (ct_Incr Text Increment Math Order))
)
)
(ssdel (ssname SS 0) SS)
)
)
)
)
(defun ct_Incr (MyString x *tMath* Ord / *error*  ParseNumbers PerformOperation SubstAtN
DOC E ELST FUN I OP OPERAND O ORD SS TMP UFLAG X)
  (vl-load-com)
  ;; Lee Mac  ~  09.04.10

  (defun *error* (msg)
(and UFlag (vla-EndUndoMark doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ))


  (defun ParseNumbers (str / isString isNumber lst tmp)

(defun isString (x lst)

  (cond (  (null lst) (list x))

(  (< 47 (car lst) 58)

   (cons x (isNumber (chr (car lst)) (cdr lst))))

(  (= 45 (car lst))

   (if (and (cadr lst)
  (numberp
(read (setq tmp (strcat "-" (chr (cadr lst)))))))

(cons x (isNumber tmp (cddr lst)))
(isString (strcat x (chr (car lst))) (cdr lst))))

(t (isString (strcat x (chr (car lst))) (cdr lst)))))

(defun isNumber (x lst)

  (cond (  (null lst) (list (read x)))

(  (= 46 (car lst))

   (if (and (cadr lst)
(numberp
  (read (setq tmp (strcat x "." (chr (cadr lst)))))))

(isNumber tmp (cddr lst))
(cons (read x) (isString (chr (car lst)) (cdr lst)))))

(  (< 47 (car lst) 58)

   (isNumber (strcat x (chr (car lst))) (cdr lst)))

(t (cons (read x) (isString (chr (car lst)) (cdr lst))))))

(if (setq lst (vl-string->list str))
  ((if (or (and (= 45 (car lst))
(< 47 (cadr lst) 58))
   (< 47 (car lst) 58)) isNumber isString) (chr (car lst)) (cdr lst))))


  (defun PerformOperation (func str operand o)
(apply (function strcat)
   (mapcar (function (lambda (x) (if (vl-position (type x) '(INT REAL))
   (vl-princ-to-string (apply func (if o (list x operand)
(list operand x)))) x)))
   (ParseNumbers str))))


  (defun SubstAtN (new n lst)
(cond (  (null lst) nil)
  (  (zerop n) (cons new (cdr lst)))
  (  (cons (car lst) (SubstAtN new (1- n) (cdr lst))))))


  (or *tMath* (setq *tMath* "Add"))
  (setq op '(("Add" . +) ("Subtract" . -) ("Divide" . /) ("Multiply" . *)))
  ;(setq *tMath* "Add")
  (setq fun (cdr (assoc *tMath* op)))
  (if (and (zerop (rem x 1)) (not (eq '/ fun))) (setq x (fix x)))
;(setq MyString (getstring T "\nEnter string with a number in it: "))
(PerformOperation fun MyString x ord)
)
(defun ct_n2s (Num / Str Decimal StrLength)
(setq Str (rtos Num 2 12)
  Decimal (vl-string-position (ascii ".") Str)
  StrLength (strlen Str)
)
(while (and (> StrLength 0) (= (substr Str StrLength 1) "0"))
(setq StrLength (- StrLength 1))
)
(cond
((< (- StrLength Decimal) 0)
(rtos NUM 2 0)
)
(T
(rtos NUM 2 (- (- StrLength Decimal) 1))
)
)
)
(defun ct_GetText (/ Increment Math Str Text StopLoop Input Data Code Pick vHeight vWidth lwrLeft uprRight vector SS Table TableEnt Row Col Ent Object ObjectName ObjectBlock AttList Att Pt1 Pt2 TestPt1 XMIN XMAX YMIN YMAX InsPt1)
(setq Text "")
(cond
((= OldValue nil)
(setq OldValue ".")
)
)
(princ (strcat "\rSelect text to copy or type text <" OldValue ">: "))
(while (not StopLoop)
(setq Input (grread T 4 2)
  Data (cadr Input)
  Code (car Input)
)
(cond
((= Code 3)
(setq Pick (vlax-3d-point Data))
(cond
(Pick
(setq vHeight (getvar "viewsize")
  vWidth (* (/ (nth 0 (getvar "screensize")) (nth 1 (getvar "screensize"))) vHeight)
  lwrLeft (list (- (nth 0 (getvar "viewctr")) (/ vWidth 2)) (- (nth 1 (getvar "viewctr")) (/ vHeight 2)) 0)
  uprRight (list (+ (nth 0 (getvar "viewctr")) (/ vWidth 2)) (+ (nth 1 (getvar "viewctr")) (/ vHeight 2)) 0)
  vector (vlax-make-safearray vlax-vbDouble '(0 . 2))
)
(vlax-safearray-fill vector '(1 1 1))
(setq vector (vlax-make-variant vector))
(cond ; Check to see if selected point was on a Table
((setq SS (ssget "C" lwrleft uprRight (list (cons 0 "ACAD_TABLE"))))
(while (and (setq TableEnt (ssname SS 0)) (not StopLoop))
(setq Table (vlax-ename->vla-object TableEnt)
  Row 0
  Col 0
)
(cond
((= (vla-hittest Table Pick vector 'Row 'Col) :vlax-true)
(setq Text (vlax-invoke-method Table 'GetText Row Col)
  StopLoop T
)
)
)
(ssdel (ssname SS 0) SS)
)
)
)
(cond ; If a table was not selected, do the following
((or (not Text) (= Text ""))
(setq Ent (nentselp "" Data))
(cond
(Ent
(setq Object (vlax-ename->vla-object (car Ent))
  ObjectType (vla-get-ObjectName Object)
)
(cond
((= ObjectType "AcDbMLeader")
(cond
((/= (vla-get-contenttype Object) 1)
(setq Text (vla-get-textstring Object)
  StopLoop T
)
)
(T
(defun LM:Itemp ( coll item )
;; © Lee Mac 2010
(if
(not
(vl-catch-all-error-p
(setq item
(vl-catch-all-apply
(function vla-item) (list coll item)
)
)
)
)
item
)
)
(setq AttList (LM:Itemp (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-get-ContentBlockName Object))
  InsPt1 (cdr (assoc 15 (entget (car Ent))))
)
(vlax-for Att AttList
(cond
((= (vla-get-objectname Att) "AcDbAttributeDefinition")
(setq  Pt1 (polar Data (* pi (/ 45 180.0)) 0.13)
   pt2 (polar Data (* pi (/ 225 180.0)) 0.13)
   TestPt1 (polar (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint Att))) (angle '(0 0 0) InsPt1) (distance '(0 0 0) InsPt1))
   XMIN (MIN (CAR Pt1)(CAR pt2))
   XMAX (MAX (CAR Pt1)(CAR pt2))
   YMIN (MIN (CADR Pt1)(CADR pt2))
   YMAX (MAX (CADR Pt1)(CADR pt2))
)
(cond
((and (< XMIN (CAR TestPt1))(> XMAX (CAR TestPt1)) (< YMIN (CADR TestPt1))(> YMAX (CADR TestPt1)))
(setq Text (vla-GetBlockAttributeValue Object (vla-get-ObjectID Att))
  StopLoop T
)
)
)
)
)
)
)
)
)
((or (wcmatch ObjectType "*Text*") (wcmatch ObjectType "*Dimension*"))
(setq Text (vla-get-textstring Object)
  StopLoop T
)
)
)
)
)
)
)
)
)
)
((= Code 2)
(if (not Str) (setq Str ""))
(cond
((<= 32 Data)
(setq Str (strcat Str (princ (chr Data))))
)
((and (> (strlen Str) 0) (= Data 8))
(setq Str (Substr Str 1 (- (strlen Str) 1)))
(princ (vl-list->string '(8 32 8)))
)
((= Data 13)
(setq Text Str
  StopLoop T
)
)
)
)
((= Code 25)
(cond
((and Str (/= Str ""))
(setq Text Str)
)
)
(setq StopLoop T)
)
)
)
(cond
((or (not Text) (= Text ""))
(setq Text OldValue)
)
(T
(setq OldValue Text)
)
)
Text
)
(defun ct_SetText (Ent Text Pt1 Pt2 Formatting / Att AttList Pt3 Pt4 Object ObjectType Rows Columns cRow cColumn XMIN XMAX YMIN YMAX XMIN2 XMAX2 YMIN2 YMAX2 Pick LowerLeft1 UpperRight1 LowerLeft2 UpperRight2 Pick1 Pick2 TestPt1)
;ct_SetText Supporting Functions
(defun ct_ChangeTable (Pick Text Table / vHeight vWidth LwrLeft Uprright vector Ent2 Table Row Col StopLoop)
(setq vHeight (getvar "viewsize")
  vWidth (* (/ (nth 0 (getvar "screensize")) (nth 1 (getvar "screensize"))) vHeight)
  lwrLeft (list (- (nth 0 (getvar "viewctr")) (/ vWidth 2)) (- (nth 1 (getvar "viewctr")) (/ vHeight 2)) 0)
  uprRight (list (+ (nth 0 (getvar "viewctr")) (/ vWidth 2)) (+ (nth 1 (getvar "viewctr")) (/ vHeight 2)) 0)
  vector (vlax-make-safearray vlax-vbDouble '(0 . 2))
  )
  (vlax-safearray-fill vector '(1 1 1))
  (setq vector (vlax-make-variant vector))
(setq Row 0
  Col 0
)
(cond
((= (vla-hittest Table Pick Vector 'Row 'Col) :vlax-true)
(cond
((= (vlax-invoke-method Table 'GetCellType Row Col) acTextCell)
(vlax-invoke-method Table 'SetText Row Col Text)
(vlax-invoke-method Table 'Update)
)
)
)
)
)
(defun ct_Mid (pt1 pt2)
(mapcar '(lambda (x y) (* 0.5 (+ x y))) pt1 pt2)
)
;End of Supporting Functions
(setq Object (vlax-ename->vla-object Ent)
  ObjectType (vla-get-ObjectName Object)
)
(cond
(Formatting
(setq Text (strcat Formatting Text))
)
)
(cond
((= ObjectType "AcDbTable")
(vla-put-RegenerateTableSuppressed Object :vlax-true)
(cond
((= Pt1 Pt2)
(ct_ChangeTable (vlax-3d-point Pt1) Text Object)
)
(T
(setq Rows (vla-get-rows Object)
  Columns (vla-get-columns Object)
  xMin (min (car Pt1) (car Pt2))
  xMax (max (car Pt1) (car Pt2))
  yMin (min (cadr Pt1) (cadr Pt2))
  yMax (max (cadr Pt1) (cadr Pt2))
  LowerLeft1 (list xMin yMin)
  UpperRight1 (list xMax yMax)
  Pick1 LowerLeft1
  Row 0
  Column 0
)
(while (< Column Columns)
(while (< Row Rows)
(setq Pick2 (vlax-safearray->list (vlax-variant-value (vla-getcellextents Object Row Column 0)))
  Pt3 (list (nth 0 Pick2) (nth 1 Pick2))
  Pt4 (list (nth 9 Pick2) (nth 10 Pick2))
  xMin2 (min (car Pt3) (car Pt4))
  xMax2 (max (car Pt3) (car Pt4))
  yMin2 (min (cadr Pt3) (cadr Pt4))
  yMax2 (max (cadr Pt3) (cadr Pt4))
  LowerLeft2 (list xMin2 yMin2)
  UpperRight2 (list xMax2 yMax2)
  Pick (ct_mid Pt3 Pt4)
)
(cond
((and (or (<= (car LowerLeft1) (car LowerLeft2) (car UpperRight1)) (<= (car LowerLeft1) (car UpperRight2) (car UpperRight1))) (or (<= (cadr LowerLeft1) (cadr LowerLeft2) (cadr UpperRight1)) (<= (cadr LowerLeft1) (cadr UpperRight2) (cadr UpperRight1))))
(ct_ChangeTable (vlax-3d-point Pick) Text Object)
)
)
(setq Row (+ Row 1))
)
(setq Column (+ Column 1)
  Row 0
)
)
)
)
(vla-put-RegenerateTableSuppressed Object :vlax-false)
)
((= ObjectType "AcDbBlockReference")
(setq XMIN (MIN (CAR pt1)(CAR pt2))
  XMAX (MAX (CAR pt1)(CAR pt2))
  YMIN (MIN (CADR pt1)(CADR pt2))
  YMAX (MAX (CADR pt1)(CADR pt2))
  AttList (vlax-safearray->list (vlax-variant-value (vla-getattributes Object)))
)
(foreach Att AttList
(setq TestPt1 (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint Att))))
(cond
((and (< XMIN (CAR TestPt1))(> XMAX (CAR TestPt1)) (< YMIN (CADR TestPt1))(> YMAX (CADR TestPt1)))
(vla-put-textstring att text)
)
)
)
)
((= ObjectType "AcDbMLeader")
;(alert "works")
(cond
((= (vla-get-contenttype Object) 1)
(defun LM:Itemp ( coll item )
;; © Lee Mac 2010
(if
(not
(vl-catch-all-error-p
(setq item
(vl-catch-all-apply
(function vla-item) (list coll item)
)
)
)
)
item
)
)
(setq AttList (LM:Itemp (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-get-ContentBlockName Object))
  InsPt1 (cdr (assoc 15 (entget Ent)))
  )
(vlax-for Att AttList
(cond
((= (vla-get-objectname Att) "AcDbAttributeDefinition")
(setq  mlPt1 (polar Pt1 (* pi (/ 45 180.0)) 0.13)
   mlpt2 (polar Pt2 (* pi (/ 225 180.0)) 0.13)
   TestPt1 (polar (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint Att))) (angle '(0 0 0) InsPt1) (distance '(0 0 0) InsPt1))
   XMIN (MIN (CAR mlPt1)(CAR mlpt2))
   XMAX (MAX (CAR mlPt1)(CAR mlpt2))
   YMIN (MIN (CADR mlPt1)(CADR mlpt2))
   YMAX (MAX (CADR mlPt1)(CADR mlpt2))
)
(cond
((and (< XMIN (CAR TestPt1))(> XMAX (CAR TestPt1)) (< YMIN (CADR TestPt1))(> YMAX (CADR TestPt1)))
(vla-SetBlockAttributeValue Object (vla-get-ObjectID Att) Text)
)
)
)
)
)
)
(T
(vla-put-textstring Object Text)
)
)
)
((wcmatch ObjectType "*Dimension*")
(vla-put-textoverride Object Text)
)
(T
(vla-put-textstring Object Text)
)
)
)
;End Supporting functions
(setq Msg "")
(setq Text (ct_GetText))
(cond
(Text
(while (not StopLoop)
(setq Msg (strcat "\rSelect text to copy to or [New value"))
(cond
(Formatting
(setq Msg (strcat Msg "/** Formatting **"))
)
(T
(setq Msg (strcat Msg "/Formatting"))
)
)
;(cond
; (Math
; (setq Msg (strcat Msg "/** Math mode: " Math " **"))
; )
; (T
; (setq Msg (strcat Msg "/Math mode"))
; )
;)
(cond
(Increment
(setq Msg (strcat Msg "/** increment " (ct_n2s Increment) " (+/-) **"))
)
(T
(setq Msg (strcat Msg "/increment (+/-)"))
)
)
(setq Msg (strcat Msg "] <" Text ">: "))
(princ Msg)
(setq Input (grread T 4 2)
  Data (cadr Input)
  Code (car Input)
  )
(cond
((= Code 2);If there was keyboard input, then do this
(cond
((or (= Data 110) (= Data 78))
(setq Text (ct_GetText))
)
((or (= Data 99) (= Data 67))
(ct_Crossing Pt1 Text Formatting Increment Math Order)
)
((or (= Data 70) (= Data 102))
(setq Formatting (getstring T "\nType the formmating code to add: "))
)
((= Data 43)
(cond
((not Increment)
(setq Increment 0)
)
)
(setq Increment (+ Increment 1))
(cond
((not Math)
(setq Math "Add")
)
)
(cond
((= Increment 0)
(setq Increment nil
  Math nil
  )
)
)
)
((= Data 45)
(cond
((not Increment)
(setq Increment 0)
)
)
(setq Increment (- Increment 1))
(cond
((not Math)
(setq Math "Add")
)
)
(cond
((= Increment 0)
(setq Increment nil
  Math nil
)
)
)
)
)
)
((= Code 3)
(setq Pt1 Data
  Ent (nentselp "" Pt1))
(cond
(Ent ; If Object is selected, run this
(setq Filter '((-4 . "<OR") (0 . "*DIMENSION*") (0 . "ACAD_TABLE") (-4 . "OR>"))
  SS (ssget Pt1 Filter)
  )
(cond
(SS
(while (setq Ent (ssname SS 0))
(ct_SetText (ssname SS 0) Text Pt1 Pt1 Formatting)
(cond
(Increment
(setq Text (ct_Incr Text Increment Math Order))
)
)
(ssdel (ssname SS 0) SS)
)
)
(T
(ct_SetText (car Ent) Text Pt1 Pt1 Formatting)
(cond
(Increment
(setq Text (ct_Incr Text Increment Math Order))
)
)
)
)
)
(T ; If blank space is selected, run this
(ct_Crossing Pt1 Text Formatting Increment Math Order)
)
)
)
)
)
)
)
)

I didn't go with the labda stuff, because to be honest, I didn't quite get how that one works, if someone can explain it, I would appreciate it.

BlackBox

  • King Gator
  • Posts: 3770
Re: Can you me Help me Speed up this code?
« Reply #13 on: August 31, 2011, 08:23:15 AM »
I didn't go with the labda stuff, because to be honest, I didn't quite get how that one works, if someone can explain it, I would appreciate it.

LAMBDA took me some time to understand as well, but once I did, I found it (lambda) to be incredibly useful.

Basically, lambda is an anonymous function, which allows you to feed the function with variable information (as an argument) which is then used within the function... all without having to worry about localizing the variable within any potential encapsulating DEFUN. You can also 'localize' variables stored with SETQ within the lambda if desired.

As a simple example:

Code: [Select]
(defun c:FOO ()
  ((lambda (str / )
    (prompt str))
    "\n** This is a lambda test ** ")
  (princ))

Now, I wouldn't normally use lambda for such a simple operation (prompting a string), as it's less code to simply prompt. This is just for example purposes.

Also, Lee *may* have a tutorial on lambda; give his website a quick look-see.  :wink:

HTH
"How we think determines what we do, and what we do determines what we get."

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: Can you me Help me Speed up this code?
« Reply #14 on: August 31, 2011, 12:14:21 PM »
Okay, I think I got the lambda part down, now here is the part of my code that I believe is causing the remaining part of my bottlneck:

Code: [Select]
(setq Rows (vla-get-rows Object)
  Columns (vla-get-columns Object)
  xMin (min (car Pt1) (car Pt2))
  xMax (max (car Pt1) (car Pt2))
  yMin (min (cadr Pt1) (cadr Pt2))
  yMax (max (cadr Pt1) (cadr Pt2))
  LowerLeft1 (list xMin yMin)
  UpperRight1 (list xMax yMax)
  Pick1 LowerLeft1
  Row 0
  Column 0
)
(while (< Column Columns)
(while (< Row Rows)
(setq Pick2 (vlax-safearray->list (vlax-variant-value (vla-getcellextents Object Row Column 0)))
  Pt3 (list (nth 0 Pick2) (nth 1 Pick2))
  Pt4 (list (nth 9 Pick2) (nth 10 Pick2))
  xMin2 (min (car Pt3) (car Pt4))
  xMax2 (max (car Pt3) (car Pt4))
  yMin2 (min (cadr Pt3) (cadr Pt4))
  yMax2 (max (cadr Pt3) (cadr Pt4))
  LowerLeft2 (list xMin2 yMin2)
  UpperRight2 (list xMax2 yMax2)
  Pick (ct_mid Pt3 Pt4)
)
(cond
((and (or (<= (car LowerLeft1) (car LowerLeft2) (car UpperRight1)) (<= (car LowerLeft1) (car UpperRight2) (car UpperRight1))) (or (<= (cadr LowerLeft1) (cadr LowerLeft2) (cadr UpperRight1)) (<= (cadr LowerLeft1) (cadr UpperRight2) (cadr UpperRight1))))
(ct_ChangeTable (vlax-3d-point Pick) Text Object)
)
)
(setq Row (+ Row 1))
)
(setq Column (+ Column 1)
  Row 0
)
)

What it does right now is step through each cell and see if it's extents are within the picked points. As a result, the larger the table, the slower this will run. Any thoughts on how to go about this a different way or perhaps improve the code?