could you do programing in Lisp of that materials, please
all selected -> automaticcally calculate in W/T
-----------------------------------------------------------------------------------------------------------------------
(defun c:ww ()
(defun *error* (msg)(princ "error: ")(princ msg)
(setvar "osmode" os)(setvar "orthomode" ot)
(princ))
;-<*error* end
(setq os (getvar "osmode") ot (getvar "orthomode")
ts (getvar "textsize"))
(setvar "orthomode" 0) (setvar "osmode" 0)
(setq ss (ssget '((0 . "text"))))
(setq grpt (grread T))
(setq pt1 (cadr grpt))
(setq ssn (sslength ss))
(setq txnum-lst nil)
(setq k 0)
(repeat ssn
(setq en (ssname ss k))
(setq tx (cdr (assoc 1 (entget en))))
(setq pn (vl-string-position (ascii ",") tx));nil
(while pn
(setq tx (strcat (substr tx 1 pn) (substr tx (+ pn 2)) ))
(setq pn (vl-string-position (ascii ",") tx))
)
;-<
(setq txnum-lst (append (@tx_num_lst tx) txnum-lst))
(setq k (+ k 1))
)
(setq ar1 (apply '* txnum-lst))
(setq ar2 (rtos ar1 2 dot))
(if (>= dot 1)
(setq ar3 (@tx_dot ar2 dot))
(setq ar3 ar2)
)
(setq ar7 (* ar1 0.00000785))
(setq dd (rtos ar7 2 1))
(setq t (entsel "\n >>> select text:"))
(setq tt (entget (car t)))
(setq ttt (assoc 1 tt))
(entmod (subst (cons 1 dd) ttt tt))
(setvar "osmode" os)(setvar "orthomode" ot)
(prin1)
)
(defun @tx_num_lst(tx / txn k tx1 tx2 tx3 txnum-lst)
(setq txn (strlen tx) tx2 "" txnum-lst nil k 1 )
(repeat (+ txn 1)
(setq tx1 (substr tx k 1))
(if (or (= 46 (ascii tx1)) (<= 48 (ascii tx1) 57))
(setq tx2 (strcat tx2 tx1))
(progn
(if (/= tx2 "")(setq txnum-lst (append txnum-lst (list (atof tx2)))) )
(setq tx2 "")
) )
(setq k (1+ k))
)
txnum-lst)
(defun @tx_dot(tx dot / k k1 tx tx1 tx2 tx3)
(setq k1 (vl-string-position (ascii ".") tx))
(if (= k1 nil) (setq tx1 (strcat tx ".0")) (setq tx1 tx))
(setq k (strlen tx1))
(setq k1 (vl-string-position (ascii ".") tx1))
(setq tx2 (substr tx1 1 (+ k1 1)))
(setq tx3 (substr tx1 (+ k1 2)))
(setq k (strlen tx3))
(while (< k dot)
(setq tx3 (strcat tx3 "0"))
(setq k (strlen tx3))
)
(strcat tx2 tx3)
)
Here you go...
(defun c:wt ( / _assoc _vl-remove unique mip-text-entmake LM:ParseNumbers txts txtst osm ss ssel p txt txtl pl xpl ypl txtls nl xn xnl pt k ) (defun _assoc ( e l f ) (car (vl-member-if '(lambda ( x ) (equal e (car x) f)) l)) ) (defun _vl-remove ( e l f ) (vl-remove-if '(lambda ( x ) (equal e x f)) l) ) (defun unique ( l ) (if l (cons (car l) (unique (_vl-remove (car l) (cdr l) 1e-6)))) ) (defun mip-text-entmake ( txt pnt height width rotation justification / ent_list ) ;;; borrowed from ShaggyDoc ;;; http://www.caduser.ru/forum/index.php?PAGE_NAME=read&FID=23&TID=30276 ;;; Draw text with entmake Lisp function ;;; Arguments: ;;; txt - text string ;;; pnt - point in WCS ;;; height - text height ;;; width - text width ;;; rotation - rotation angle ;;; justification - justification or nil (setq ent_list (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText") (list 10 (car pnt) (cadr pnt) 0.0) (cons 1 txt) (cons 40 height) (cons 7 (getvar "TEXTSTYLE")) (if justification (cond ((= justification "C") '(72 . 1) ) ((= justification "R") '(72 . 2) ) ((= justification "A") '(72 . 3) ) ((= justification "M") '(72 . 4) ) ((= justification "F") '(72 . 5) ) (t '(72 . 0) ) ) ;_ end of cond '(72 . 0) ) ;_ end of if (cons 50 rotation) (cons 41 width) (list 11 (car pnt) (cadr pnt) 0.0) ) ;_ end of list ) ;_ end of setq (setq ent_list (entmakex ent_list)) ) ;;-------------------=={ Parse Numbers }==--------------------;; ;; ;; ;; Parses a list of numerical values from a supplied string. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; s - String to process ;; ;;------------------------------------------------------------;; ;; Returns: List of numerical values found in string. ;; ;;------------------------------------------------------------;; (defun LM:ParseNumbers ( s ) ( (lambda ( l ) (read (strcat "(" (vl-list->string (mapcar (function (lambda ( a b c ) (if (or (< 47 b 58) (and (= 45 b) (< 47 c 58) (not (< 47 a 58))) (and (= 46 b) (< 47 a 58) (< 47 c 58)) ) b 32 ) ) ) (cons nil l) l (append (cdr l) (list nil)) ) ) ")" ) ) ) (vl-string->list s) ) ) (setq txts (getvar 'textsize)) (setvar 'textsize 150.0) (setq txtst (getvar 'textstyle)) (setvar 'textstyle "JW") (setq osm (getvar 'osmode)) (setvar 'osmode 0) (setq ss (ssget '((0 . "TEXT")))) (setq ssel (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) (foreach ent ssel (setq p (cdr (assoc 11 (entget ent))) txt (cdr (assoc 1 (entget ent))) ) (setq txtl (cons (cons p txt) txtl)) (setq pl (cons p pl)) ) (setq xpl (vl-sort pl '(lambda ( a b ) (< (car a) (car b))))) (setq xpl (mapcar 'car xpl)) (setq xpl (unique xpl)) (setq ypl (vl-sort pl '(lambda ( a b ) (> (cadr a) (cadr b))))) (setq ypl (mapcar 'cadr ypl)) (setq ypl (unique ypl)) (foreach y ypl (foreach x xpl (setq txtls (cons (cdr (_assoc (list x y 0.0) txtl 1e-6)) txtls)) ) ) (setq txtls (reverse txtls)) (foreach y ypl (foreach x xpl (if (/= (atof (car txtls)) 0.0) (setq nl (cons (atof (car txtls)) nl)) (foreach n (LM:ParseNumbers (car txtls)) (setq nl (cons n nl)) ) ) (setq txtls (cdr txtls)) ) (setq xn (apply '* nl)) (setq xn (* xn 0.00000785)) (setq xnl (cons xn xnl)) (setq nl nil) ) (setq xnl (reverse xnl)) (prompt "\nSpecify position of resulting W/T of materials - middle of W/T column of table...") (command "_.xline" "_V" "\\" "") (setq pt (cdr (assoc 10 (entget (entlast))))) (entdel (entlast)) (setq k -1) (foreach n xnl (mip-text-entmake (rtos n 2 1) (list (car pt) (nth (setq k (1+ k)) ypl) 0.0) 0.0 0.8 0.0 "M") ) (setvar 'textsize txts) (setvar 'textstyle txtst) (setvar 'osmode osm) (princ) )
HTH, M.R.
one more,,, please...
I wish W/T stand right in a column like the image...
.
@nychoe1 wrote:one more,,, please...
I wish W/T stand right in a column like the image...
.
(defun c:wt ( / _assoc _vl-remove unique mip-text-entmake LM:ParseNumbers txts txtst osm ss ssel p txt txtl pl xpl ypl txtls nl xn xnl pt k ) (defun _assoc ( e l f ) (car (vl-member-if '(lambda ( x ) (equal e (car x) f)) l)) ) (defun _vl-remove ( e l f ) (vl-remove-if '(lambda ( x ) (equal e x f)) l) ) (defun unique ( l ) (if l (cons (car l) (unique (_vl-remove (car l) (cdr l) 1e-6)))) ) (defun mip-text-entmake ( txt pnt height width rotation justification justification_vertical / ent_list ) ;;; borrowed from ShaggyDoc ;;; http://www.caduser.ru/forum/index.php?PAGE_NAME=read&FID=23&TID=30276 ;;; Draw text with entmake Lisp function ;;; Arguments: ;;; txt - text string ;;; pnt - point in WCS ;;; height - text height ;;; width - text width ;;; rotation - rotation angle ;;; justification - justification or nil ;;; justification_vertical - justification_vertical or nil (setq ent_list (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText") (list 10 (car pnt) (cadr pnt) 0.0) (cons 1 txt) (cons 40 height) (cons 7 (getvar "TEXTSTYLE")) (if justification (cond ((= justification "C") '(72 . 1) ) ((= justification "R") '(72 . 2) ) ((= justification "A") '(72 . 3) ) ((= justification "M") '(72 . 4) ) ((= justification "F") '(72 . 5) ) (t '(72 . 0) ) ) ;_ end of cond '(72 . 0) ) ;_ end of if (cons 50 rotation) (cons 41 width) (list 11 (car pnt) (cadr pnt) 0.0) (if justification_vertical (cond ((= justification_vertical "C") '(73 . 0) ) ((= justification_vertical "T") '(73 . 1) ) ((= justification_vertical "M") '(73 . 2) ) ((= justification_vertical "B") '(73 . 3) ) (t '(73 . 0) ) ) ;_ end of cond '(73 . 0) ) ;_ end of if ) ;_ end of list ) ;_ end of setq (setq ent_list (entmakex ent_list)) ) ;;-------------------=={ Parse Numbers }==--------------------;; ;; ;; ;; Parses a list of numerical values from a supplied string. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; s - String to process ;; ;;------------------------------------------------------------;; ;; Returns: List of numerical values found in string. ;; ;;------------------------------------------------------------;; (defun LM:ParseNumbers ( s ) ( (lambda ( l ) (read (strcat "(" (vl-list->string (mapcar (function (lambda ( a b c ) (if (or (< 47 b 58) (and (= 45 b) (< 47 c 58) (not (< 47 a 58))) (and (= 46 b) (< 47 a 58) (< 47 c 58)) ) b 32 ) ) ) (cons nil l) l (append (cdr l) (list nil)) ) ) ")" ) ) ) (vl-string->list s) ) ) (setq txts (getvar 'textsize)) (setvar 'textsize 150.0) (setq txtst (getvar 'textstyle)) (setvar 'textstyle "JW") (setq osm (getvar 'osmode)) (setvar 'osmode 0) (setq ss (ssget '((0 . "TEXT")))) (setq ssel (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) (foreach ent ssel (setq p (cdr (assoc 11 (entget ent))) txt (cdr (assoc 1 (entget ent))) ) (setq txtl (cons (cons p txt) txtl)) (setq pl (cons p pl)) ) (setq xpl (vl-sort pl '(lambda ( a b ) (< (car a) (car b))))) (setq xpl (mapcar 'car xpl)) (setq xpl (unique xpl)) (setq ypl (vl-sort pl '(lambda ( a b ) (> (cadr a) (cadr b))))) (setq ypl (mapcar 'cadr ypl)) (setq ypl (unique ypl)) (foreach y ypl (foreach x xpl (setq txtls (cons (cdr (_assoc (list x y 0.0) txtl 1e-6)) txtls)) ) ) (setq txtls (reverse txtls)) (foreach y ypl (foreach x xpl (if (/= (atof (car txtls)) 0.0) (setq nl (cons (atof (car txtls)) nl)) (foreach n (LM:ParseNumbers (car txtls)) (setq nl (cons n nl)) ) ) (setq txtls (cdr txtls)) ) (setq xn (apply '* nl)) (setq xn (* xn 0.00000785)) (setq xnl (cons xn xnl)) (setq nl nil) ) (setq xnl (reverse xnl)) (prompt "\nSpecify position of resulting W/T of materials - right side of W/T column of table...") (command "_.xline" "_V" "\\" "") (setq pt (cdr (assoc 10 (entget (entlast))))) (entdel (entlast)) (setq k -1) (foreach n xnl (mip-text-entmake (rtos n 2 1) (list (car pt) (nth (setq k (1+ k)) ypl) 0.0) 0.0 0.8 0.0 "R" "M") ) (setvar 'textsize txts) (setvar 'textstyle txtst) (setvar 'osmode osm) (princ) )
M.R.