Hello everyone,
I have a LISP program that I would like to use in AutoCAD LT, but it doens't work on AutoCAD LT. The code includes functions for manipulating tables and other objects.
Could anyone please advise if there is any way to get this to work in AutoCAD LT? Are there alternative methods or tools that could replicate the functionality of this LISP script in LT?
Thank you in advance for your assistance!
Here is the program I'm trying to run:
;; Tab.lsp ;;
(defun rectangle_dims (e / l a b)
(setq l (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) e)))
(if
(and
(or
(= 1 (logand (cdr (assoc 70 e)) 1))
(equal (car l) (last l) 1e-8)
)
(equal (distance (car l) (caddr l)) (distance (cadr l) (cadddr l)) 1e-8)
(equal (mapcar '- (cadr l) (car l)) (mapcar '- (caddr l) (cadddr l)) 1e-8)
(equal (mapcar '- (caddr l) (cadr l)) (mapcar '- (cadddr l) (car l)) 1e-8)
)
(vl-sort (list (fix (distance (car l) (cadr l))) (fix (distance (cadr l) (caddr l)))) '<)
)
)
(defun C:TAB (/ *error* ss e old r p1 c)
(vl-load-com)
(setq acObj (vlax-get-acad-object)
acDoc (vla-get-activedocument acObj)
space (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'PaperSpace 'ModelSpace))
)
(vla-startundomark acDoc)
;;;;;; Error function ;;;;;;;;;
(defun *error* (msg)
(and
msg
(not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*"))
(princ (strcat "\nError: " msg))
)
(vla-endundomark acDoc)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if
(setq ss (ssget '((0 . "LWPOLYLINE") (-4 . "<OR") (90 . 4) (90 . 5) (-4 . "OR>"))))
(progn
(repeat (setq i (sslength ss))
(setq e (ssname ss (setq i (1- i)))
c (cond
((cdr (assoc 62 (entget e))))
((cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8 (entget e)))))))
)
c (if (zerop c) 7 c)
)
(if
(and
(setq dims (rectangle_dims (entget e)))
(setq dims (cons c dims))
)
(if
(setq old (vl-some '(lambda (d) (if (equal (cdr d) dims 1e-8) d)) r))
(setq r (subst (cons (1+ (car old)) dims) old r))
(setq r (cons (cons 1 dims) r))
)
)
)
(if
(and r (setq p1 (getpoint "\nSpecify table insert point: ")))
(insert_table
(vl-sort
(vl-sort
(vl-sort
(mapcar '(lambda (a) (list (fix (cadr a)) (fix (caddr a)) (fix (cadddr a)) (car a))) r)
'(lambda (a b) (< (cadr a) (cadr b)))
)
'(lambda (a b) (< (car a) (car b)))
)
'(lambda (a b) (> (caddr a) (caddr b)))
)
p1
)
)
)
)
(princ)
)
;;The textheight in table depends on cannonscale
(defun insert_table (lst pct / tab row col ht i n acol)
(setq ht (/ 2.5 (getvar 'cannoscalevalue))
pct (trans pct 1 0)
n (trans '(1 0 0) 1 0 T)
tab (setq tab (vla-addtable space (vlax-3d-point pct) (+ 3 (length lst)) 3 (* 1.5 ht) ht))
acol (vla-getinterfaceobject acobj (strcat "AutoCAD.AcCmColor." (substr (vla-get-version acobj) 1 2)))
)
(vlax-put tab 'direction n)
(vla-mergecells tab 1 1 0 2)
(mapcar
(function
(lambda (rowType)
(vla-SetTextStyle tab rowType (getvar 'textstyle))
(vla-SetTextHeight tab rowType ht)
)
)
'(2 4 1)
)
(vla-put-HorzCellMargin tab (* 0.14 ht))
(vla-put-VertCellMargin tab (* 0.14 ht))
(setq lst (cons '(nil "SECTION" "LENGHT" "PCS") lst))
(setq lst (mapcar '(lambda (el) (list (car el) (last el) (cadr el) (caddr el))) lst))
(setq lst (cons '(nil "sp:" nil nil) lst))
(setq i 0)
(foreach col (apply 'mapcar (cons 'list (mapcar 'cdr lst)))
(vla-SetColumnWidth tab i
(apply
'max
(mapcar
'(lambda (x)
((lambda (txb) (+ (abs (- (caadr txb) (caar txb))) (* 2.0 ht)))
(textbox (list (cons 1 (vl-princ-to-string x)) (cons 7 (getvar 'textstyle)) (cons 40 ht)))
)
)
col
)
)
)
(setq i (1+ i))
)
(setq lst (cons '(nil "XX") lst))
(setq row 0)
(foreach r lst
(setq col 0)
(vla-SetRowHeight tab row (* 1.5 ht))
(foreach c (cdr r)
(vla-SetText tab row col (vl-princ-to-string c))
(if
(car r)
(progn
(if (/= (vla-get-colorindex acol) (car r)) (vla-put-colorindex acol (car r)))
(vla-SetCellContentColor tab row col acol)
)
)
(setq col (1+ col))
)
(setq row (1+ row))
)
)
(princ "\nType TAB to start the command")
Hello everyone,
I have a LISP program that I would like to use in AutoCAD LT, but it doens't work on AutoCAD LT. The code includes functions for manipulating tables and other objects.
Could anyone please advise if there is any way to get this to work in AutoCAD LT? Are there alternative methods or tools that could replicate the functionality of this LISP script in LT?
Thank you in advance for your assistance!
Here is the program I'm trying to run:
;; Tab.lsp ;;
(defun rectangle_dims (e / l a b)
(setq l (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) e)))
(if
(and
(or
(= 1 (logand (cdr (assoc 70 e)) 1))
(equal (car l) (last l) 1e-8)
)
(equal (distance (car l) (caddr l)) (distance (cadr l) (cadddr l)) 1e-8)
(equal (mapcar '- (cadr l) (car l)) (mapcar '- (caddr l) (cadddr l)) 1e-8)
(equal (mapcar '- (caddr l) (cadr l)) (mapcar '- (cadddr l) (car l)) 1e-8)
)
(vl-sort (list (fix (distance (car l) (cadr l))) (fix (distance (cadr l) (caddr l)))) '<)
)
)
(defun C:TAB (/ *error* ss e old r p1 c)
(vl-load-com)
(setq acObj (vlax-get-acad-object)
acDoc (vla-get-activedocument acObj)
space (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'PaperSpace 'ModelSpace))
)
(vla-startundomark acDoc)
;;;;;; Error function ;;;;;;;;;
(defun *error* (msg)
(and
msg
(not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*"))
(princ (strcat "\nError: " msg))
)
(vla-endundomark acDoc)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if
(setq ss (ssget '((0 . "LWPOLYLINE") (-4 . "<OR") (90 . 4) (90 . 5) (-4 . "OR>"))))
(progn
(repeat (setq i (sslength ss))
(setq e (ssname ss (setq i (1- i)))
c (cond
((cdr (assoc 62 (entget e))))
((cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8 (entget e)))))))
)
c (if (zerop c) 7 c)
)
(if
(and
(setq dims (rectangle_dims (entget e)))
(setq dims (cons c dims))
)
(if
(setq old (vl-some '(lambda (d) (if (equal (cdr d) dims 1e-8) d)) r))
(setq r (subst (cons (1+ (car old)) dims) old r))
(setq r (cons (cons 1 dims) r))
)
)
)
(if
(and r (setq p1 (getpoint "\nSpecify table insert point: ")))
(insert_table
(vl-sort
(vl-sort
(vl-sort
(mapcar '(lambda (a) (list (fix (cadr a)) (fix (caddr a)) (fix (cadddr a)) (car a))) r)
'(lambda (a b) (< (cadr a) (cadr b)))
)
'(lambda (a b) (< (car a) (car b)))
)
'(lambda (a b) (> (caddr a) (caddr b)))
)
p1
)
)
)
)
(princ)
)
;;The textheight in table depends on cannonscale
(defun insert_table (lst pct / tab row col ht i n acol)
(setq ht (/ 2.5 (getvar 'cannoscalevalue))
pct (trans pct 1 0)
n (trans '(1 0 0) 1 0 T)
tab (setq tab (vla-addtable space (vlax-3d-point pct) (+ 3 (length lst)) 3 (* 1.5 ht) ht))
acol (vla-getinterfaceobject acobj (strcat "AutoCAD.AcCmColor." (substr (vla-get-version acobj) 1 2)))
)
(vlax-put tab 'direction n)
(vla-mergecells tab 1 1 0 2)
(mapcar
(function
(lambda (rowType)
(vla-SetTextStyle tab rowType (getvar 'textstyle))
(vla-SetTextHeight tab rowType ht)
)
)
'(2 4 1)
)
(vla-put-HorzCellMargin tab (* 0.14 ht))
(vla-put-VertCellMargin tab (* 0.14 ht))
(setq lst (cons '(nil "SECTION" "LENGHT" "PCS") lst))
(setq lst (mapcar '(lambda (el) (list (car el) (last el) (cadr el) (caddr el))) lst))
(setq lst (cons '(nil "sp:" nil nil) lst))
(setq i 0)
(foreach col (apply 'mapcar (cons 'list (mapcar 'cdr lst)))
(vla-SetColumnWidth tab i
(apply
'max
(mapcar
'(lambda (x)
((lambda (txb) (+ (abs (- (caadr txb) (caar txb))) (* 2.0 ht)))
(textbox (list (cons 1 (vl-princ-to-string x)) (cons 7 (getvar 'textstyle)) (cons 40 ht)))
)
)
col
)
)
)
(setq i (1+ i))
)
(setq lst (cons '(nil "XX") lst))
(setq row 0)
(foreach r lst
(setq col 0)
(vla-SetRowHeight tab row (* 1.5 ht))
(foreach c (cdr r)
(vla-SetText tab row col (vl-princ-to-string c))
(if
(car r)
(progn
(if (/= (vla-get-colorindex acol) (car r)) (vla-put-colorindex acol (car r)))
(vla-SetCellContentColor tab row col acol)
)
)
(setq col (1+ col))
)
(setq row (1+ row))
)
)
(princ "\nType TAB to start the command")
Do you know which functions specifically don't work? I am assuming it is the VLA/VLAX functions that manipulate the table? In which case, you might be able to change it to use entmod instead. Unfortunately, I don't have LT on this computer so I wouldn't be able to test the code.
Do you know which functions specifically don't work? I am assuming it is the VLA/VLAX functions that manipulate the table? In which case, you might be able to change it to use entmod instead. Unfortunately, I don't have LT on this computer so I wouldn't be able to test the code.
already answered in your other post by @komondormrex
already answered in your other post by @komondormrex
Can't find what you're looking for? Ask the community or share your knowledge.