Recent Posts

Pages: 1 2 [3] 4 5 ... 10
21
AutoLISP (Vanilla / Visual) / Re: nxn matrices - challenge
« Last post by ribarm on July 12, 2024, 01:26:36 AM »
It seems that @dgpuertas version also works well... So I was wrong, but he omitted to provide all subs that goes with his version...

Code - Auto/Visual Lisp: [Select]
  1. (defun invmcomplex ( mat / a b r i )
  2.   (setq a (mapcar (function (lambda ( v ) (mapcar (function car) v))) mat)
  3.         b (mapcar (function (lambda ( v ) (mapcar (function cadr) v))) mat)
  4.         r (invm (m+m a (mxm (mxm b (invm a)) b)))
  5.         i (invm (m+m b (mxm (mxm a (invm b)) a)))
  6.   )
  7.  
  8.   (mapcar (function (lambda ( a b ) (mapcar (function (lambda ( c d ) (list c (- d)))) a b))) r i)
  9. )
  10.  
  11. ;; Matrix Inverse  -  gile & Lee Mac
  12. ;; Uses Gauss-Jordan Elimination to return the inverse of a non-singular nxn matrix.
  13. ;; Args: m - nxn matrix
  14.  
  15. (defun invm ( m / c f p r)
  16.  
  17.   (defun f ( p m )
  18.     (mapcar (function (lambda ( x ) (mapcar (function (lambda ( a b ) (- a (* (car x) b)))) (cdr x) p))) m)
  19.   )
  20.  
  21.   (setq  m (mapcar (function append) m (imat (length m))))
  22.   (while m
  23.     (setq c (mapcar (function (lambda ( x ) (abs (car x)))) m))
  24.       (setq m (append (cdr m) (list (car m))))
  25.     )
  26.     (if (equal 0.0 (caar m) 1e-14)
  27.       (setq m nil
  28.             r nil
  29.       )
  30.       (setq p (mapcar (function (lambda ( x ) (/ (float x) (caar m)))) (cdar m))
  31.             m (f p (cdr m))
  32.             r (cons p (f p r))
  33.       )
  34.     )
  35.   )
  36.   (reverse r)
  37. )
  38.  
  39. ;; Identity Matrix  -  Lee Mac
  40. ;; Args: n - matrix dimension
  41.  
  42. (defun imat ( n / i j l m )
  43.   (repeat (setq i n)
  44.     (repeat (setq j n)
  45.       (setq l (cons (if (= i j) 1.0 0.0) l)
  46.             j (1- j)
  47.       )
  48.     )
  49.     (setq m (cons l m)
  50.           l nil
  51.           i (1- i)
  52.     )
  53.   )
  54.   m
  55. )
  56.  
  57. ;; Matrix Transpose  -  Doug Wilson
  58. ;; Args: m - nxn matrix
  59.  
  60. (defun trp ( m )
  61. )
  62.  
  63. ;; Matrix x Matrix - Lee Mac
  64. ;; Args: m,n - nxn matrices
  65.  
  66. (defun mxm ( m n )
  67.   ((lambda ( a ) (mapcar (function (lambda ( r ) (mxv a r))) m)) (trp n))
  68. )
  69.  
  70. ;; Matrix + Matrix - Lee Mac
  71. ;; Args: m,n - nxn matrices
  72.  
  73. (defun m+m ( m n )
  74.   (mapcar (function (lambda ( r s ) (mapcar (function +) r s))) m n)
  75. )
  76.  
22
Hi guys,
I am using a lisp (AREAP from Lee Mac) to show the areas of a polyline or a hatch, by clicking the object first, then clicking the attribute in the block.
just wonder if there is a way to detect the block within the polyline or hatch, then do it for me without clicking repeatly one by one.
I have to do thousands of area tags eveyday. that is why I came up with this idea. Hopefully someone could help me out.
Thank you


23
AutoLISP (Vanilla / Visual) / Re: Replace text with block Attribute
« Last post by BIGAL on July 11, 2024, 07:36:59 PM »
You post on multiple forums so you should know by now about this. It will return nil if it does not exist. So just insert at 0,0 then erase, it exists in dwg then.

Code: [Select]
(if (not (tblsearch "block" T2B_Baseblock))
24
AutoLISP (Vanilla / Visual) / Re: nxn matrices - challenge
« Last post by ribarm on July 11, 2024, 05:04:07 PM »
Maybe I am wrong, but that with Matlab is IMHO pretty bad...
@dgpuertas, I think that inverse of complex matrix you proposed is somewhat wrong...
Here is my example for which I think is correct...

Code - Auto/Visual Lisp: [Select]
  1. ;; Matrix Inverse Complex  -  gile & Lee Mac
  2. ;; Uses Gauss-Jordan Elimination to return the inverse of a non-singular nxn complex matrix.
  3. ;; Args: m - nxn complex matrix
  4.  
  5. (defun invmcomplex ( m / car-_vl-sort-i f c p r )
  6.  
  7.   (defun car-_vl-sort-i ( lst fun )
  8.     (car (mapcar (function (lambda ( x ) (nth x lst))) (vl-sort-i lst fun)))
  9.   )
  10.  
  11.   (defun f ( p m )
  12.     (mapcar (function (lambda ( x ) (mapcar (function (lambda ( a b ) (c-c a (cxc (car x) b)))) (cdr x) p))) m)
  13.   )
  14.  
  15.   (setq  m (mapcar (function append) m (imatcomplex (length m))))
  16.   (while m
  17.     (setq c (mapcar (function (lambda ( x ) (list (abs (caar x)) (abs (cadar x))))) m))
  18.     (repeat (vl-position (car-_vl-sort-i c (function (lambda ( a b ) (if (equal (car a) (car b) 1e-6) (> (cadr a) (cadr b)) (> (car a) (car b)))))) c)
  19.       (setq m (append (cdr m) (list (car m))))
  20.     )
  21.     (if (equal (list 0.0 0.0) (caar m) 1e-14)
  22.       (setq m nil
  23.             r nil
  24.       )
  25.       (setq p (mapcar (function (lambda ( x ) (c/c (mapcar 'float x) (caar m)))) (cdar m))
  26.             m (f p (cdr m))
  27.             r (cons p (f p r))
  28.       )
  29.     )
  30.   )
  31.   (reverse r)
  32. )
  33.  
  34. ;; Identity Matrix Complex  -  Lee Mac
  35. ;; Args: n - complex matrix dimension
  36.  
  37. (defun imatcomplex ( n / i j l m )
  38.   (repeat (setq i n)
  39.     (repeat (setq j n)
  40.       (setq l (cons (if (= i j) (list 1.0 0.0) (list 0.0 0.0)) l)
  41.             j (1- j)
  42.       )
  43.     )
  44.     (setq m (cons l m)
  45.           l nil
  46.           i (1- i)
  47.     )
  48.   )
  49.   m
  50. )
  51.  
  52. (defun cxc ( c1 c2 / a1 a2 b1 b2 r i )
  53.   (setq a1 (car c1) b1 (cadr c1))
  54.   (setq a2 (car c2) b2 (cadr c2))
  55.   (setq r (- (* a1 a2) (* b1 b2)))
  56.   (setq i (+ (* a1 b2) (* a2 b1)))
  57.   (list r i)
  58. )
  59.  
  60. (defun c-c ( c1 c2 )
  61.   (mapcar (function -) c1 c2)
  62. )
  63.  
  64. (defun c+cm ( clst )
  65.   (list (apply (function +) (mapcar (function car) clst)) (apply (function +) (mapcar (function cadr) clst)))
  66. )
  67.  
  68. (defun c_ ( c1 )
  69.   (list (car c1) (- (cadr c1)))
  70. )
  71.  
  72. (defun c/c ( c1 c2 / d )
  73.   ( (lambda ( d ) (mapcar (function (lambda ( x ) (/ x d))) (cxc c1 (c_ c2))))
  74.     (car (cxc c2 (c_ c2)))
  75.   )
  76. )
  77.  
  78. (invmcomplex (list (list '(2 5) '(3 6) '(7 2) '(4 2)) (list '(1 8) '(2 6) '(3 2) '(6 5)) (list '(9 2) '(3 4) '(4 3) '(2 5)) (list '(8 4) '(4 6) '(5 6) '(6 5))))
  79. (((-0.0120802851247421 0.162220971675108) (0.0634402551116113 -0.166197711498781) (0.259463515287938 -0.01755768148565) (-0.24111798912024 -0.000225098480585259)) ((0.023597824048021 -0.554980303882949) (-0.315850684674545 0.317613956105796) (-0.553217032451698 0.00986681673232037) (0.714274995310448 0.170211967735884)) ((-0.0759332207840931 0.114912774338773) (0.141624460701557 0.107709622960045) (0.164246858000375 0.242018383042581) (-0.134646407803414 -0.382367285687488)) ((-0.100131307447008 0.201763271431251) (0.215906959294691 -0.127893453385856) (0.0897767773400863 -0.0436691052335397) (-0.156968673794785 -0.082611142374789)))
  80.  
  81. (invmcomplex '(((-0.0120802851247421 0.162220971675108) (0.0634402551116113 -0.166197711498781) (0.259463515287938 -0.01755768148565) (-0.24111798912024 -0.000225098480585259)) ((0.023597824048021 -0.554980303882949) (-0.315850684674545 0.317613956105796) (-0.553217032451698 0.00986681673232037) (0.714274995310448 0.170211967735884)) ((-0.0759332207840931 0.114912774338773) (0.141624460701557 0.107709622960045) (0.164246858000375 0.242018383042581) (-0.134646407803414 -0.382367285687488)) ((-0.100131307447008 0.201763271431251) (0.215906959294691 -0.127893453385856) (0.0897767773400863 -0.0436691052335397) (-0.156968673794785 -0.082611142374789))))
  82. (((1.99999999999997 5.00000000000003) (2.99999999999995 6.00000000000001) (6.99999999999996 2.00000000000003) (3.99999999999994 2.00000000000001)) ((0.999999999999948 8.00000000000004) (1.99999999999994 6.0) (2.99999999999995 2.00000000000002) (5.99999999999994 5.00000000000001)) ((8.99999999999999 2.00000000000003) (2.99999999999996 4.00000000000002) (3.99999999999998 3.00000000000004) (1.99999999999996 5.00000000000005)) ((7.99999999999998 4.00000000000006) (3.99999999999994 6.00000000000003) (4.99999999999996 6.00000000000005) (5.99999999999994 5.00000000000005)))
  83.  

Regards, M.R.
25
AutoLISP (Vanilla / Visual) / Replace text with block Attribute
« Last post by mhy3sx on July 11, 2024, 09:38:44 AM »
Hi. I use this code to replace text with block Attribute. The problem is that this code work only if the block already exists in the drawing. Is any way to update the code to call the block from the path
"c:\\myblock\\Block1.dwg"

Code - Auto/Visual Lisp: [Select]
  1. (defun c:TEST(/ scl scl1 T2B_Selection T2B_Baseblock T2B_AttributeTag T2B_ActiveLayout T2B_ActiveDoc T2B_Text T2B_Block)
  2.   (setq scl (getvar "useri1"))
  3.   (setq scl1 (* scl 0.0025))
  4.    (setq T2B_Baseblock    "P_DX")
  5.    (setq T2B_AttributeTag "SBK")  
  6.   (princ "\n Select text to replace with block.")  
  7.    (if
  8.       (and
  9.          (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list (vla-get-Blocks (setq T2B_ActiveDoc (vla-get-ActiveDocument (vlax-get-acad-object)))) T2B_Baseblock))))
  10.          (setq T2B_Selection (ssget '((0 . "*TEXT"))))
  11.       )
  12.       (progn
  13.          (setq T2B_ActiveLayout (vla-get-Block (vla-get-ActiveLayout T2B_ActiveDoc)))
  14.          (vla-StartUndoMark T2B_ActiveDoc)
  15.          (foreach T2B_Text (mapcar 'cadr (ssnamex T2B_Selection))
  16.             (if
  17.                (= (type T2B_Text) 'ENAME)
  18.                (progn
  19.                   (setq T2B_Text (vlax-ename->vla-object T2B_Text))
  20.                   ;(setq T2B_Block (vla-InsertBlock T2B_ActiveLayout (vla-get-InsertionPoint T2B_Text) T2B_Baseblock 1 1 1 0))
  21.                   (setq T2B_Block (vla-InsertBlock T2B_ActiveLayout (vla-get-InsertionPoint T2B_Text) T2B_Baseblock  scl1 scl1 scl1 0))
  22.                   (PushAttValue T2B_Block (list (list T2B_AttributeTag (vla-get-TextString T2B_Text))))
  23.                   (vla-Delete T2B_Text)
  24.                )
  25.             )
  26.          )
  27.          (vla-EndUndoMark T2B_ActiveDoc)
  28.          (vlax-release-object T2B_ActiveLayout)
  29.       )
  30.    )
  31.    (vlax-release-object T2B_ActiveDoc)
  32.    (princ)
  33. )
  34.  
  35. (defun PushAttValue (PAV_BlkObject PAV_TagValList / PAV_AttList)
  36.    (if
  37.       (and
  38.          (= (type PAV_BlkObject)     'VLA-OBJECT)
  39.          (= (vla-get-ObjectName    PAV_BlkObject) "AcDbBlockReference")
  40.          (= (vla-get-HasAttributes PAV_BlkObject) :vlax-true)
  41.       )    
  42.       (progn
  43.          (setq PAV_AttList (vlax-safearray->list (vlax-variant-value (vla-GetAttributes PAV_BlkObject))))
  44.          (foreach PAV_Item PAV_AttList
  45.             (vl-catch-all-apply 'vla-put-TextString (list PAV_Item (cadr (assoc (strcase (vla-get-TagString PAV_Item)) PAV_TagValList))))
  46.          )
  47.      )          
  48.    )
  49. )  
  50.  

Thanks
26
The main future of GeomCAL.arx is the speed-of-calculation of math.
Replacing GeomCAL.arx  with a cloneCAL.vlx,
 Do you not downgrade too much the speed-of-math into many vlx'programs?
 How to CPU'function/s mmx directly inside vlisp?
 :tongue2:

Hi d2010,

why don't you do a benchmark test by yourself?
According to my test under AutoCAD 2012 CADCAL is about 10% slower than GeomCAL. But this changes when i.e. in a loop the same math expression is called repeatedly. CADCAL always translates the math expression to a Lisp expression, which then is executed. All this translations within one drawing session are stored, and when the same math expression is called again, it doesn't need to be parsed again, the Lisp then is called directly. Parsing is quite computing intensive, and CADCAL needs to parse an expression only once.

BTW  - the BricsCAD Lisp interpreter is very much faster than that of AutoCAD, at least 10 times ore more. So CADCAL under BricsCAD ist much faster than GeomCAL under AutoCAD. And while GeomCAL is available only for AutoCAD, CADCAL supports BricsCAD too.

And then CADCAL has much more predefined functions than GeomCAL. Just one example: PCT(ratio) asks the user to pick a curve entity (line, polyline, 3Dpoly, spline, circle, arc, ellipse, elliptic arc) and returns the point on that curve that divides the curve's length at the given ratio. Or the predefined PGR(p1,p2) which returns a point that divides the distance between p1 and p2 in the golden ratio.

And then CADCAL has a very comfortable DCL frontend, which can be called (even transparently) with the command DDCAL. And this DCL frontend stores the history of the last 30 CADCAL expressions together with their results. Even when you close the DWG and reopen it days later, the history will still be there. You can re-use the results any time later. And you can export the history to a script file.

And then CADCAL allows parametric scripting, very similar to dynamic blocks. And these paremetrically defined drawing parts can be edited later and change their look according to the new property values which you give them.

And with the next BETA comming tomorrow these parametrically defined objects can talk to each other. This allows you to build simple modells for simulations. As an example there will be a switch object which can change it's property "power" from "on" to "off", and when this switch object is connected to lamp objects, these will immediately reflect the state of the switch.

And these scripts which can define parametric drawing parts which can communicate to each other can be translated to Lisp functions, which can become the heart of your own application for AutoCAD or BricsCAD.

You see, that there is much more to CADCAL. The GeomCAL functionality is just a small part of the whole thing.


27
AutoLISP (Vanilla / Visual) / Re: how to use CADCAL as a Lisp code generator
« Last post by d2010 on July 10, 2024, 08:41:48 AM »
The main future of GeomCAL.arx is the speed-of-calculation of math.
Replacing GeomCAL.arx  with a cloneCAL.vlx,
 Do you not downgrade too much the speed-of-math into many vlx'programs?
 How to CPU'function/s mmx directly inside vlisp?
 :tongue2:


28
AutoLISP (Vanilla / Visual) / Re: C3D Point Group Query
« Last post by CHulse on July 10, 2024, 07:22:47 AM »
29
Have a Look at This  :



Code - Auto/Visual Lisp: [Select]
  1. (defun c:a ()
  2.   (setq s (car (entsel "\n  Select Object  :  ")))
  3.   (setq en1 (entget s '("*")))
  4.   (setq en2 en1)
  5.   (foreach a en1
  6.     (cond
  7.       ((not (member (car a) '(-3 1 8 10 11 12 13 14 40 41 42 50 90 100 210)))
  8.        (setq en3 (vl-remove a en2))
  9.        (cond ((entmake en3) (print a) (entdel (entlast)) (setq en2 en3)))
  10.       )
  11.     )
  12.   )
  13.   (entdel s)
  14.   (entmake en2)
  15.   (princ)
  16. )



30
AutoLISP (Vanilla / Visual) / Re: Help: Layer polyline Area Table
« Last post by mhy3sx on July 09, 2024, 03:24:12 AM »
Thanks BIGAL, works perfect
Pages: 1 2 [3] 4 5 ... 10