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

0 Members and 1 Guest are viewing this topic.

dgorsman

  • Water Moccasin
  • Posts: 2437
Re: Can you me Help me Speed up this code?
« Reply #15 on: August 31, 2011, 12:37:56 PM »
Where I find the (lambda...) really shines is processing each entry in a list (especially multiple matched lists) with the same routine, without any loop index to track, making sure the list stays in order, throwing up a separate (defun...) and all its localization, and so on.  Kind of like a functionalized version of (foreach...) but with a few extra goodies.
If you are going to fly by the seat of your pants, expect friction burns.

try {GreatPower;}
   catch (notResponsible)
      {NextTime(PlanAhead);}
   finally
      {MasterBasics;}

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: Can you me Help me Speed up this code?
« Reply #16 on: August 31, 2011, 02:47:51 PM »
Ok, so in doing a search online, I found a tool that helped me figure out what to do to get only the cells that are selected and I have gotten that work as follows:
Code: [Select]
(vla-SelectSubRegion Object (vlax-3d-point Pt1) (vlax-3d-point Pt2) (vlax-3D-point '(0 0 1.0)) (vlax-3D-point '(0 0 1.0)) acWindow :vlax-false 'RowMin 'RowMax 'ColMin 'ColMax)
(setq Row RowMin
  Column ColMin
)
(while (<= Row RowMax)
(while (<= Column ColMax)
(cond
((= (vlax-invoke-method Object 'GetCellType Row Column) acTextCell)
(vlax-invoke-method Object 'SetText Row Column Text)
(vlax-invoke-method Object 'Update)
)
)
(setq Column (+ Column 1))
)
(setq Row (+ Row 1)
  Column ColMin
)
)

The problem now is if the user picks a point that is outside the table, it errors out. Any ideas on how to resolve such a situation? I want the user to be able to select multiple items, even if part of it is a table and have it work though.

BlackBox

  • King Gator
  • Posts: 3770
Re: Can you me Help me Speed up this code?
« Reply #17 on: August 31, 2011, 03:13:29 PM »
Perhaps comparing the user specified point against the limits (LL, UR) or the Table's BoundingBox will help?
"How we think determines what we do, and what we do determines what we get."

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Can you me Help me Speed up this code?
« Reply #18 on: August 31, 2011, 04:36:05 PM »
Just add an error trap and return nil when no selection is made.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: Can you me Help me Speed up this code?
« Reply #19 on: August 31, 2011, 04:44:13 PM »
Perhaps comparing the user specified point against the limits (LL, UR) or the Table's BoundingBox will help?
Yes, I was starting to think along these lines as I want to be able to adjust the crossing box to be at the edges of the table.

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: Can you me Help me Speed up this code?
« Reply #20 on: August 31, 2011, 04:45:06 PM »
Just add an error trap and return nil when no selection is made.
But a selection is being made, it's just part of the crossing window is outside the table, so the comparison method above has worked.

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: Can you me Help me Speed up this code?
« Reply #21 on: August 31, 2011, 04:55:15 PM »
I think I have it now, thank you all for your input, I have learned a lot. Here is what I have:

Code: [Select]
;*****************************************************************************************************************************************
; CopyText **
; Written by: Chris Wade **
;        Version 3.0 **
;    08/31/2011  **
;             **
; - Completely rewritten from scratch to improve reliability and speed.  **
; - Removed functions that did not seem to get used to reduce code foot print. **
; - Reduced dependency on code written by others.                   **
;                           **
;*****************************************************************************************************************************************
; Credits: **
; - 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           **
; - Inspiration for Table handling from Cadalyst Tip ALSPSOL0406a                         **
; - Special thanks to all of those @ TheSwamp.org for their assistance.                     **
; 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)
)
((lambda (i / Ent)
(while (setq Ent (ssname SS (setq i (1+ i))))
(ct_SetText Ent Text Pt1 Pt2 Formatting)
(cond
(Increment
(setq Text (ct_Incr Text Increment Math Order))
)
)
)
)
-1)
)
)
)
(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)))
(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 (/ RowMin RowMax ColMin ColMax 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 Ent (nentselp "" Data))
(cond
(Ent
(setq Object (vlax-ename->vla-object (car Ent))
  ObjectType (vla-get-ObjectName Object)
)
(cond
((= ObjectType "AcDbTable")
(vla-SelectSubRegion Object Pick Pick (vlax-3D-point '(0 0 1.0)) (vlax-3D-point '(0 0 1.0)) acWindow :vlax-false 'RowMin 'RowMax 'ColMin 'ColMax)
(setq Text (vlax-invoke-method Table 'GetText RowMin ColMin)
  StopLoop T
)
)
((= 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 / BL UR RowMin RowMax ColMin ColMax 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_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)
(vla-getboundingbox Object 'BL 'UR)
(setq BL (vlax-safearray->list BL)
  UR (vlax-safearray->list UR)  
)
(cond
((< (Car Pt1) (car BL))
(setq Pt1 (list (car BL) (cadr Pt1) (caddr Pt1)))
)
)
(cond
((< (cadr Pt1) (cadr BL))
(setq Pt1 (list (car Pt1) (cadr BL) (caddr Pt1)))
)
)
(cond
((> (Car Pt1) (car UR))
(setq Pt1 (list (car UR) (cadr Pt1) (caddr Pt1)))
)
)
(cond
((> (cadr Pt1) (cadr UR))
(setq Pt1 (list (car Pt1) (cadr UR) (caddr Pt1)))
)
)
(cond
((< (Car Pt2) (car BL))
(setq Pt2 (list (car BL) (cadr Pt2) (caddr Pt2)))
)
)
(cond
((< (cadr Pt2) (cadr BL))
(setq Pt2 (list (car Pt2) (cadr BL) (caddr Pt2)))
)
)
(cond
((> (Car Pt2) (car UR))
(setq Pt2 (list (car UR) (cadr Pt2) (caddr Pt2)))
)
)
(cond
((> (cadr Pt2) (cadr UR))
(setq Pt2 (list (car Pt2) (cadr UR) (caddr Pt2)))
)
)
(vla-SelectSubRegion Object (vlax-3d-point Pt1) (vlax-3d-point Pt2) (vlax-3D-point '(0 0 1.0)) (vlax-3D-point '(0 0 1.0)) acWindow :vlax-false 'RowMin 'RowMax 'ColMin 'ColMax)
(setq Row RowMin
  Column ColMin
)
(while (<= Row RowMax)
(while (<= Column ColMax)
(cond
((= (vlax-invoke-method Object 'GetCellType Row Column) acTextCell)
(vlax-invoke-method Object 'SetText Row Column Text)
(vlax-invoke-method Object 'Update)
)
)
(setq Column (+ Column 1))
)
(setq Row (+ Row 1)
  Column ColMin
)
)
(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")
(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
(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
((lambda (i / Ent)
(while (setq Ent (ssname SS (setq i (1+ i))))
(ct_SetText Ent Text Pt1 Pt1 Formatting)
(cond
(Increment
(setq Text (ct_Incr Text Increment Math Order))
)
)
)
)
-1)
)
(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)
)
)
)
)
)
)
)
)