Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 10/17/2019 in all areas

  1. The code could alternatively be written: (if (<= pi (getvar 'snapang)) (setvar 'snapang (- (getvar 'snapang) pi)) ) Or simply: (setvar 'snapang (rem (getvar 'snapang) pi))
    1 point
  2. Had a play then realised going in wrong direction, need suppress heading added. But method is there copy one of the tables use as master, pick the 1st value in left column 3rd row down keep repeating. ; add columns from one table to another ; make multi tables into 1 ; By Alan H Oct 2019 info@alanh.com.au (defun c:mrgtab ( / pbj pbj2 x col col2 colwid ent col2ac row pt pick lwrleft urright lst ss) (setq oldsnap (getvar 'osmode)) (setq obj (vlax-ename->vla-object (car (entsel "Pick master table")))) (setq row (vla-get-Rows obj)) (setq col (vla-get-Columns obj)) (setq colwid (vla-getcolumnwidth obj (- col 1))) (setvar 'osmode 0) (while (setq pt (getpoint "\nSelect top Cell for column values in other table: ")) (setq pick (vlax-3d-point pt)) (vla-InsertColumns obj col (vla-getcolumnwidth obj (- col 1)) 1) (setq row2 (vla-get-Rows obj)) (setq col (+ col 1)) (setq lwrleft (polar pt (* pi 1.25) 2)) (setq uprright (polar pt (* pi 0.25) 2)) (setq vector (vlax-3D-point (trans (getvar 'viewdir) 1 0))) (setq SS (ssget "C" lwrleft uprright (list (cons 0 "ACAD_TABLE")))) (setq Obj2 (vlax-ename->vla-object (ssname SS 0))) (if (= (vla-hittest Obj2 pick vector 'rown 'coln) :vlax-true) (setq lst (list rown coln)) ) (setq col2 (nth 1 lst)) (setq rowst (nth 0 lst)) (setq x rowst) (repeat (- row2 rowst ) (setq txt (vla-getText Obj2 x col2 )) (vla-SetText Obj x (- col 1) txt) (setq x (+ x 1)) ) ) ) (c:mrgtab)
    1 point
  3. another by math algorithm & entmod without 'vla-move' & 'vlax-intersectwith' select texts then pick a line (defun c:test (/ ok ss en enx np l x y i p) (if (and (princ "\nSelect Texts to Align ") (setq ss (ssget "_:L" '((0 . "TEXT,MTEXT")))) (setq en (car (entsel "\nSelect LINE.."))) (setq enx (entget en)) (= (cdr (assoc 0 enx)) "LINE") (setq l (mapcar ''((x) (cdr (assoc x enx))) '(10 11) ) x (vl-sort l ''((a b) (<= (car a) (car b)))) y (vl-sort l ''((a b) (<= (cadr a) (cadr b)))) ) ) (progn (repeat (setq i (sslength ss)) (setq enx (entget (ssname ss (setq i (1- i))))) (setq c (if (or (= (cdr (assoc 0 enx)) "MTEXT") (equal (setq p (cdr (assoc 11 enx))) '(0.0 0.0 0.0) 1e-7) ) 10 11 ) ) (setq p (cdr (assoc c enx))) (and (setq ok (or (setq np (hp:IntersOnX p x)) ;(setq np (hp:IntersOnY p y)) ) ) (entmod (subst (cons c np) (cons c p) enx)) (grdraw (trans np 0 1) (trans p 0 1) 2) ) ) (if (not ok) (princ "\nSorry.. out of range!") ) ) (princ "\nOops.. please retry ") ) (princ) ) (defun hp:IntersOnX (p l / xy) ;hanhphuc (setq xy '((x)(mapcar '* x '(1.0 1.0))) p (xy p)) (cadr (assoc T (cons (list (vl-some ''((x)(equal p (xy x) 1e-4)) l) p) (mapcar ''((a b / d )(setq d (xy (mapcar '- b a))) (list (<= (car a) (car p) (car b)) (list (car p) (+ (cadr a) (* (- (car p) (car a)) (if (vl-some 'zerop d) 0. (/ 1. (apply '/ d )))))) ) ) l (cdr l) ) ) ) ) )
    1 point
  4. Using later version of Excel can detect strings v's numbers did not play much, you have to open csv say notepad Ctrl+A Ctrl+c then use paste.
    1 point
×
×
  • Create New...