Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 11/09/2020 in all areas

  1. Quickly written: (defun c:fixatt ( / i s ) (if (setq s (ssget "_:L" '((0 . "INSERT") (66 . 1)))) (repeat (setq i (sslength s)) (foreach a (vlax-invoke (vlax-ename->vla-object (ssname s (setq i (1- i)))) 'getattributes) (if (and (vlax-write-enabled-p a) (= :vlax-false (vla-get-invisible a))) (vla-put-rotation a (LM:readable (vla-get-rotation a))) ) ) ) ) (princ) ) ;; Readable - Lee Mac ;; Returns an angle corrected for text readability. (defun LM:readable ( a ) ( (lambda ( a ) (if (and (< (* pi 0.5) a) (<= a (* pi 1.5))) (LM:readable (+ a pi)) a ) ) (rem (+ a pi pi) (+ pi pi)) ) ) (vl-load-com) (princ)
    1 point
  2. I'll translate it in a better language for you BIGAL, simply put: Click three point 1, 2, and 3 and have the function return the inside angle formed by the points 123. I'll leave the rest to you .
    1 point
  3. (defun test (str) (vl-list->string (subst 44 32 ((lambda (x) (vl-remove nil (mapcar '(lambda (a b) (if (not (= a b 32)) b) ) (cons nil x) x ) ) ) (vl-string->list (vl-string-trim " "str)) ) ) ) )
    1 point
  4. I already re-edit the code, I forgot it wasn't just the constant attributes, but also the changing attributes. Refresh the page
    1 point
  5. I think I see what you're after... (defun c:test ( / i rtn ss tags) (setq tags ; these are the tags. They will appear left to right sorted in the order below '( "DESC-S" "PTNO-S" "QTY-S" ) ) (if (setq ss (ssget '((0 . "INSERT")))) (progn (repeat (setq i (sslength ss)) (setq rtn (cons (mapcar 'cdr (vl-sort (vl-remove nil (mapcar '(lambda (x / ps) (if (setq ps (vl-position (vla-get-TagString x) tags)) (cons ps (vla-get-TextString x)) ) ) ((lambda (x) (append (vlax-invoke x 'GetConstantAttributes) (vlax-invoke x 'GetAttributes))) (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ) ) ) '(lambda (a b) (< (car a) (car b))) ) ) rtn ) ) ) (JH:list-to-table (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) (append '(("Data Extraction")) (list tags) (vl-remove nil rtn)) (getpoint "\nSpecify insertion point for table: ") (getvar 'ctablestyle) ) ) ) ) ;; 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 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 )
    1 point
×
×
  • Create New...