Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 11/29/2023 in all areas

  1. @barristann Take a little more time to understand what the arguments of the function mean and how to program in Visual LISP. Note: "space" is a variable that holds the ActiveX object for AutoCAD's Model Space. You retrieve the working space with the following: ;; Retrieves the current active space you are working in, whether MSPACE or PSPACE (setq doc (vla-get-activedocument (vlax-get-acad-object)) space (if (> (getvar "CVPORT") 1)(vla-get-modelspace doc)(vla-get-paperspace doc)) ) Try this after the JH:List-to-table function is loaded: (defun c:tatest (/ coords space pt1) ; localize your variables (vl-load-com) ; must be a list of strings. first list is title, next list is header rows. (setq Coords '(("Table Title") ("head1" "head2" "head3") ("123" "-50" "10") ("124" "50" "-13") ("223" "-150" "120") ("123" "-1.50" "-10") ) ) ;; Retrieves the current active space you are working in, whether MSPACE or PSPACE (setq doc (vla-get-activedocument (vlax-get-acad-object)) space (if (> (getvar "CVPORT") 1)(vla-get-modelspace doc)(vla-get-paperspace doc)) ) ; don't run the function unless a point is acutally selected (if (setq pt1 (getpoint "\nSelect Insertion Point: ")) (JH:list-to-table space coords pt1 "Standard") ) ; exit quietly (no return value) (princ) )
    2 points
  2. This is my version of List-To-Table. Some curtesy of mine to share my function that I use in my workplace ;; JH:list-to-table --> Jonathan Handojo ;; Creates a table from a list of lists of strings ;; space - ModelSpace or Paperspace vla object ;; lst - list of lists where each list is a list of strings ;; => if you wish to insert a block in the cell, prefix using "<block>" followed by the block name ;; => e.x. if you want to insert the block "TestBlock1", input the string as "<block>TestBlock1" ;; pt - Insertion point of table (2 or 3 reals) ;; tblstyle - Table style to use (defun JH:list-to-table (space lst pt tblstyle / i j lens ncols rows totlen txt vtable) (setq ncols (apply 'max (mapcar 'length lst)) vtable (vla-AddTable space (vlax-3d-point pt) (length lst) ncols 10 10) ) (vla-put-RegenerateTableSuppressed vtable :vlax-true) (vla-put-StyleName vtable tblstyle) (repeat (setq i (length lst)) (setq rows (nth (setq i (1- i)) lst)) (vla-SetRowHeight vtable i (* 2 (vlax-invoke vtable 'GetCellTextHeight i 0))) (repeat (setq j (length rows)) (setq lens (cons (+ (abs (apply '- (mapcar 'car (textbox (list (cons 1 (setq txt (nth (setq j (1- j)) rows))) (cons 40 (vlax-invoke vtable 'GetCellTextHeight i j)) (cons 7 (vlax-invoke vtable 'GetCellTextStyle i j)) ) ) ) ) ) (vlax-invoke vtable 'GetCellTextHeight i j) ) lens ) ) (if (eq (strcase (substr txt 1 7)) "<BLOCK>") (progn (setq blk (substr txt 8)) (if (and (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*") (vlax-method-applicable-p vtable 'setblocktablerecordid32) ) (vla-SetBlockTableRecordId32 vtable i j (vla-get-ObjectID (vla-item (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) blk))) (vla-SetBlockTableRecordId vtable i j (vla-get-ObjectID (vla-item (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) blk)) :vlax-true) ) ) (vla-SetText vtable i j txt) ) ) (setq totlen (cons lens totlen) lens nil) ) (repeat ncols (vla-SetColumnWidth vtable (setq ncols (1- ncols)) (apply 'max (vl-remove nil (mapcar '(lambda (x) (nth ncols x) ) totlen ) ) ) ) ) (vla-put-RegenerateTableSuppressed vtable :vlax-false) vtable )
    2 points
  3. This is way better than my approach... https://www.theswamp.org/index.php?topic=58809.0 (defun c:slot ( / cmd dict ent lastent obj prev ss vals vars *error*) ;; ----------------------------------------------------------- ;; ;; Draw Slot 29-11-2023 by dexus ;; ;; ----------------------------------------------------------- ;; ;; https://www.theswamp.org/index.php?topic=58809 ;; ;; ----------------------------------------------------------- ;; ;; Draw a slot with preview ;; ;; Prompts user for radius, startpoint and endpoint ;; ;; Global variable 'slot:rad' for last radius ;; ;; ----------------------------------------------------------- ;; (defun *error* (msg) (and vals (mapcar (function setvar) vars vals)) (or (wcmatch (strcase msg t) "*break,*cancel*,*exit*") (princ (strcat "\n* Error: " msg))) (princ) ) (setq vars '("cmdecho" "peditaccept" "qaflags") vals (mapcar (function getvar) vars) dict (cdar (dictsearch (namedobjdict) "acad_mlinestyle"))) (mapcar (function setvar) vars '(0 1 0)) (initget 6) (if (cond ((not (setq slot:rad (cond ((getdist (if (numberp slot:rad) (strcat "\nSpecify slot radius <" (rtos slot:rad 2 3) ">: ") "\nSpecify slot radius: "))) (slot:rad) ) )) (princ "\nNo slot radius chosen.") nil ) ((not (setq ent ; Create MLineStyle (list '(0 . "MLINESTYLE") '(100 . "AcDbMlineStyle") '(2 . "SLOT") '(70 . 1088) '(3 . "") '(51 . 1.5708) '(52 . 1.5708) '(71 . 2) (cons 49 slot:rad) '(62 . 256) '(6 . "BYLAYER") (cons 49 (- slot:rad)) '(62 . 256) '(6 . "BYLAYER") ) ))) ((setq prev (dictsearch dict "slot")) ; If Slot exists, entmod (entmod (cons (assoc -1 prev) ent)) t ) ((dictadd dict "SLOT" (entmakex ent)) ; Otherwise create Slot t ) ((princ "\nCreation of mline failed...") nil) ) (progn (setq lastent (entlast) cmd (getvar 'cmdecho)) (setvar 'cmdecho 0) (princ "\nChoose first point: ") (command "_mline" "_j" "_z" "_st" "SLOT" "\\") ; Create Mline (princ "\nChoose end point: ") (command "\\" "") ; Get endpoint of Mline (if (not (equal lastent (setq obj (entlast)))) (progn (setq lastent (entlast) ss (ssadd)) (command "_explode" obj) ; Explode Mline (while (> (getvar "cmdactive") 0) (command "")) (while (setq lastent (entnext lastent)) (ssadd lastent ss)) (command "_.pedit" "_m" ss "" "_j" "0.0" "") ; Convert to polyline (setq ss nil) ) ) (setvar 'cmdecho cmd) ) ) (mapcar (function setvar) vars vals) (princ) )
    1 point
  4. Brilliant pkenewell! It works! Thank you so much for the explanation, pkenewell!
    1 point
  5. A slightly different way, if all the texts are in the format "ABC (NxY)" and where the numbers could be any length. Returns anything after the first '(' MyString is the text string to change (if (setq MyPos (vl-string-search "(" MyString)) ; position of deliminator, ( (setq MyString (substr MyString (+ MyPos 1)) ) ; if contains "(" MyString ; If doesn't contain "(" )
    1 point
×
×
  • Create New...