Community
Visual LISP, AutoLISP and General Customization
cancel
Turn on suggestions
Auto-suggest helps you quickly narrow down your search results by suggesting possible matches as you type.
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Text and tables lisp

3 REPLIES 3
Back to AutoCAD Customization Category
Back to Topic Listing
Reply
Message 1 of 4
kzD1219
Collaborator
1082 Views, 3 Replies
‎04-01-2016 06:44 AM
‎04-01-2016 06:44 AM

Text and tables lisp

I am not a programmer so I really am not sure if it is possible, but thought I would try to see if there is any way to make things quicker with a lsp routine.

 

I have an arc and labelled it with a piece of text.  But I want that piece of text shown in a table with the Arc, Radius and I angle.  So if I constantly labelled the arc with a specific text letter, is it possible to produce a table of all 'C-number' labels in a simple table. Real simple since the drafters I am dealing with need things simple.  

Preview file
9 KB
Preview file
41 KB
Report
0 Likes
Reply
3 REPLIES 3
Message 2 of 4
marko_ribar
Advisor
in reply to: kzD1219
‎04-01-2016 03:16 PM
‎04-01-2016 03:16 PM

Hey, try this and see if it suits your needs...

 

(defun c:arclabeltable ( / *adoc* *error* arclabelprefix sstxt txtl ssarc arcl arc r l a tt datalst csvf f p1 p2 ul lr table r )

  (vl-load-com)
  (setq *adoc* (vla-get-activedocument (vlax-get-acad-object)))

  (defun *error* ( m )
    (vla-endundomark *adoc*)
    (if m
      (prompt m)
    )
    (princ)
  )

  (vla-startundomark *adoc*)
  (initget 1)
  (setq arclabelprefix (getstring t "\nSpecify ARCs label prefix (case sensitive) : "))
  (setq sstxt (ssget "_A" (list '(0 . "TEXT") (cons 1 (strcat arclabelprefix "*")) (cons 410 (if (= (getvar 'cvport) 1) (getvar 'c	) "Model")))))
  (setq txtl (vl-sort (vl-remove-if 'listp (mapcar 'cadr (ssnamex sstxt))) '(lambda ( a b ) (if (= (cdr (assoc 1 (entget a))) (cdr (assoc 1 (entget b)))) (if (= (cdr (assoc 8 (entget a))) (cdr (assoc 8 (entget b)))) (< (safearray-value (variant-value (vla-get-truecolor a))) (safearray-value (variant-value (vla-get-truecolor b)))) (< (cdr (assoc 8 (entget a))) (cdr (assoc 8 (entget b))))) (< (cdr (assoc 1 (entget a))) (cdr (assoc 1 (entget b))))))))
  (setq ssarc (ssget "_A" '((0 . "ARC"))))
  (setq arcl (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssarc))))
  (foreach txt txtl
    (setq arc (car (vl-sort arcl '(lambda ( a b ) (< (distance (trans (cdr (assoc 10 (entget txt))) txt 0) (vlax-curve-getclosestpointto a (trans (cdr (assoc 10 (entget txt))) txt 0))) (distance (trans (cdr (assoc 10 (entget txt))) txt 0) (vlax-curve-getclosestpointto b (trans (cdr (assoc 10 (entget txt))) txt 0))))))))
    (setq tt (cdr (assoc 1 (entget txt))))
    (setq l (vlax-curve-getdistatparam arc (vlax-curve-getendparam arc)))
    (setq r (cdr (assoc 40 (entget arc))))
    (setq a (rem (+ pi pi (- (cdr (assoc 51 (entget arc))) (cdr (assoc 50 (entget arc))))) (+ pi pi)))
    (setq datalst (cons (list tt l r a) datalst))
  )
  (setq datalst (reverse datalst))
  (setq f (open (setq csvf (strcat (getvar 'dwgprefix) "ARCLABELTABLE.csv")) "w"))
  (write-line "LABEL,LENGTH,RADIUS,ANGLE" f)
  (write-line "" f)
  (foreach data datalst
    (write-line (strcat (car data) "," (rtos (cadr data) 2 8) "," (rtos (caddr data) 2 8) "," (vl-string-translate "d" (chr 176) (angtos (cadddr data) 1 2))) f)
  )
  (close f)
  (setq p1 (getpoint "\nPick or specify corner of table : "))
  (setq p2 (getcorner p1 "\nPick or specify other corner of table : "))
  (setq ul (list (apply 'min (mapcar 'car (list p1 p2))) (apply 'max (mapcar 'cadr (list p1 p2))) 0.0))
  (setq lr (list (apply 'max (mapcar 'car (list p1 p2))) (apply 'min (mapcar 'cadr (list p1 p2))) 0.0))
;|  
  (entmake
    (list
      '(0 . "OLE2FRAME")
      '(100 . "AcDbEntity")
      (cons 410 (if (= (getvar 'cvport) 1) (getvar 'ctab) "Model"))
      '(100 . "AcDbOle2Frame")
      '(70 . 2)
      '(3 . "Microsoft Excel Macro-Enabled Worksheet")
      (cons 10 ul)
      (cons 11 lr)
      '(71 . 1)
      '(72 . 0)
      '(73 . 2)
      (list -3 (list "ACAD" '(1000 . "OLEBEGIN") '(1070 . 70) '(1070 . 1) '(1070 . 71) '(1070 . 1) '(1070 . 40) '(1040 . 0.0) '(1070 . 41) (cons 1040 (- (car lr) (car ul))) '(1070 . 42) (cons 1040 (- (cadr ul) (cadr lr))) '(1070 . 72) '(1070 . 0) '(1070 . 3) '(1000 . "") '(1070 . 90) '(1071 . 0) '(1070 . 43) '(1040 . 0.0) '(1070 . 4) '(1000 . "") '(1070 . 91) '(1071 . 0) '(1070 . 44) '(1040 . 0.0) '(1000 . "OLEEND") '(1000 . "OLEITEM_SOURCEFILEPATH") '(1002 . "{") (cons 1000 csvf) '(1002 . "}")))
    )
  )
|;
  (setq table (vla-addtable (vla-get-block (vla-get-activelayout *adoc*)) (vlax-3d-point ul) (+ 2 (length datalst)) 4 (/ (- (cadr ul) (cadr lr)) (+ 2 (length datalst))) (/ (- (car lr) (car ul)) 4)))
  (vla-SetValueFromText table 0 0 1 "ARCS DATA" acParseOptionNone)
  (vla-SetCellTextHeight table 0 0 (/ (/ (- (cadr ul) (cadr lr)) (+ 2 (length datalst))) 4))
  (vla-SetValueFromText table 1 0 1 "LABEL" acParseOptionNone)
  (vla-SetCellTextHeight table 1 0 (/ (/ (- (cadr ul) (cadr lr)) (+ 2 (length datalst))) 4))
  (vla-SetValueFromText table 1 1 1 "LENGTH" acParseOptionNone)
  (vla-SetCellTextHeight table 1 1 (/ (/ (- (cadr ul) (cadr lr)) (+ 2 (length datalst))) 4))
  (vla-SetValueFromText table 1 2 1 "RADIUS" acParseOptionNone)
  (vla-SetCellTextHeight table 1 2 (/ (/ (- (cadr ul) (cadr lr)) (+ 2 (length datalst))) 4))
  (vla-SetValueFromText table 1 3 1 "ANGLE" acParseOptionNone)
  (vla-SetCellTextHeight table 1 3 (/ (/ (- (cadr ul) (cadr lr)) (+ 2 (length datalst))) 4))
  (setq r 1)
  (foreach data datalst
    (setq r (1+ r))
    (vla-SetValueFromText table r 0 1 (car data) acParseOptionNone)
    (vla-SetCellTextHeight table r 0 (/ (/ (- (cadr ul) (cadr lr)) (+ 2 (length datalst))) 4))
    (vla-SetCellAlignment table r 0 acMiddleCenter)
    (vla-SetValueFromText table r 1 1 (rtos (cadr data) 2 8) acParseOptionNone)
    (vla-SetCellTextHeight table r 1 (/ (/ (- (cadr ul) (cadr lr)) (+ 2 (length datalst))) 4))
    (vla-SetCellAlignment table r 1 acMiddleCenter)
    (vla-SetValueFromText table r 2 1 (rtos (caddr data) 2 8) acParseOptionNone)
    (vla-SetCellTextHeight table r 2 (/ (/ (- (cadr ul) (cadr lr)) (+ 2 (length datalst))) 4))
    (vla-SetCellAlignment table r 2 acMiddleCenter)
    (vla-SetValueFromText table r 3 1 (vl-string-translate "d" (chr 176) (angtos (cadddr data) 1 2)) acParseOptionNone)
    (vla-SetCellTextHeight table r 3 (/ (/ (- (cadr ul) (cadr lr)) (+ 2 (length datalst))) 4))
    (vla-SetCellAlignment table r 3 acMiddleCenter)
  )
  (startapp "EXPLORER" csvf)
  (*error* nil)
)

HTH, M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)
Report
0 Likes
Reply
Message 3 of 4
marko_ribar
Advisor
in reply to: marko_ribar
‎04-02-2016 12:38 PM
‎04-02-2016 12:38 PM

Code updated - still remains the problem of (entmake) OLE csv table, but I did find some not so happy workaround...

 

(defun c:arclabeltable ( / *adoc* *error* arclabelprefix sstxt txtl ssarc arcl arc r l a tt datalst csvf f p1 p2 ul lr table r )

  (vl-load-com)
  (setq *adoc* (vla-get-activedocument (vlax-get-acad-object)))

  (defun *error* ( m )
    (vla-endundomark *adoc*)
    (if m
      (prompt m)
    )
    (princ)
  )

  (vla-startundomark *adoc*)
  (initget 1)
  (setq arclabelprefix (getstring t "\nSpecify ARCs label prefix (case sensitive) : "))
  (setq sstxt (ssget "_A" (list '(0 . "TEXT") (cons 1 (strcat arclabelprefix "*")) (cons 410 (if (= (getvar 'cvport) 1) (getvar 'c	) "Model")))))
  (setq txtl (vl-sort (vl-remove-if 'listp (mapcar 'cadr (ssnamex sstxt))) '(lambda ( a b ) (if (= (cdr (assoc 1 (entget a))) (cdr (assoc 1 (entget b)))) (if (= (cdr (assoc 8 (entget a))) (cdr (assoc 8 (entget b)))) (< (safearray-value (variant-value (vla-get-truecolor a))) (safearray-value (variant-value (vla-get-truecolor b)))) (< (cdr (assoc 8 (entget a))) (cdr (assoc 8 (entget b))))) (< (cdr (assoc 1 (entget a))) (cdr (assoc 1 (entget b))))))))
  (setq ssarc (ssget "_A" '((0 . "ARC"))))
  (setq arcl (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssarc))))
  (foreach txt txtl
    (setq arc (car (vl-sort arcl '(lambda ( a b ) (< (distance (trans (cdr (assoc 10 (entget txt))) txt 0) (vlax-curve-getclosestpointto a (trans (cdr (assoc 10 (entget txt))) txt 0))) (distance (trans (cdr (assoc 10 (entget txt))) txt 0) (vlax-curve-getclosestpointto b (trans (cdr (assoc 10 (entget txt))) txt 0))))))))
    (setq tt (cdr (assoc 1 (entget txt))))
    (setq l (vlax-curve-getdistatparam arc (vlax-curve-getendparam arc)))
    (setq r (cdr (assoc 40 (entget arc))))
    (setq a (rem (+ pi pi (- (cdr (assoc 51 (entget arc))) (cdr (assoc 50 (entget arc))))) (+ pi pi)))
    (setq datalst (cons (list tt l r a) datalst))
  )
  (setq datalst (reverse datalst))
  (setq f (open (setq csvf (strcat (getvar 'dwgprefix) "ARCLABELTABLE.csv")) "w"))
  (write-line "LABEL,LENGTH,RADIUS,ANGLE" f)
  (write-line "" f)
  (foreach data datalst
    (write-line (strcat (car data) "," (rtos (cadr data) 2 8) "," (rtos (caddr data) 2 8) "," (vl-string-translate "d" (chr 176) (angtos (cadddr data) 1 2))) f)
  )
  (close f)
  (setq p1 (getpoint "\nPick or specify corner of table : "))
  (setq p2 (getcorner p1 "\nPick or specify other corner of table : "))
  (setq ul (list (apply 'min (mapcar 'car (list p1 p2))) (apply 'max (mapcar 'cadr (list p1 p2))) 0.0))
  (setq lr (list (apply 'max (mapcar 'car (list p1 p2))) (apply 'min (mapcar 'cadr (list p1 p2))) 0.0))
;|
  (entmake
    (list
      '(0 . "OLE2FRAME")
      '(100 . "AcDbEntity")
      '(67 . 0)
      (cons 410 (if (= (getvar 'cvport) 1) (getvar 'ctab) "Model"))
      (cons 8 (getvar 'clayer))
      '(100 . "AcDbOle2Frame")
      '(70 . 2)
      '(3 . "Microsoft Excel Macro-Enabled Worksheet")
      (cons 10 ul)
      (cons 11 lr)
      '(71 . 1)
      '(72 . 0)
      '(73 . 2)
      (list -3 (list "ACAD" '(1000 . "OLEBEGIN") '(1070 . 70) '(1070 . 1) '(1070 . 71) '(1070 . 0) '(1070 . 40) '(1040 . 0.0) '(1070 . 41) (cons 1040 (- (car lr) (car ul))) '(1070 . 42) (cons 1040 (- (cadr ul) (cadr lr))) '(1070 . 72) '(1070 . 0) '(1070 . 3) '(1000 . "") '(1070 . 90) '(1071 . 0) '(1070 . 43) '(1040 . 0.0) '(1070 . 4) '(1000 . "") '(1070 . 91) '(1071 . 0) '(1070 . 44) '(1040 . 0.0) '(1000 . "OLEEND") '(1000 . "OLEITEM_SOURCEFILEPATH") '(1002 . "{") (cons 1000 csvf) '(1002 . "}")))
    )
  )
|;
  (setq table (vla-addtable (vla-get-block (vla-get-activelayout *adoc*)) (vlax-3d-point ul) (+ 2 (length datalst)) 4 (/ (- (cadr ul) (cadr lr)) (+ 2 (length datalst))) (/ (- (car lr) (car ul)) 4)))
  (vla-SetValueFromText table 0 0 1 "ARCS DATA" acParseOptionNone)
  (vla-SetCellTextHeight table 0 0 (/ (/ (- (cadr ul) (cadr lr)) (+ 2 (length datalst))) 4))
  (vla-SetValueFromText table 1 0 1 "LABEL" acParseOptionNone)
  (vla-SetCellTextHeight table 1 0 (/ (/ (- (cadr ul) (cadr lr)) (+ 2 (length datalst))) 4))
  (vla-SetValueFromText table 1 1 1 "LENGTH" acParseOptionNone)
  (vla-SetCellTextHeight table 1 1 (/ (/ (- (cadr ul) (cadr lr)) (+ 2 (length datalst))) 4))
  (vla-SetValueFromText table 1 2 1 "RADIUS" acParseOptionNone)
  (vla-SetCellTextHeight table 1 2 (/ (/ (- (cadr ul) (cadr lr)) (+ 2 (length datalst))) 4))
  (vla-SetValueFromText table 1 3 1 "ANGLE" acParseOptionNone)
  (vla-SetCellTextHeight table 1 3 (/ (/ (- (cadr ul) (cadr lr)) (+ 2 (length datalst))) 4))
  (setq r 1)
  (foreach data datalst
    (setq r (1+ r))
    (vla-SetValueFromText table r 0 1 (car data) acParseOptionNone)
    (vla-SetCellTextHeight table r 0 (/ (/ (- (cadr ul) (cadr lr)) (+ 2 (length datalst))) 4))
    (vla-SetCellAlignment table r 0 acMiddleCenter)
    (vla-SetValueFromText table r 1 1 (rtos (cadr data) 2 8) acParseOptionNone)
    (vla-SetCellTextHeight table r 1 (/ (/ (- (cadr ul) (cadr lr)) (+ 2 (length datalst))) 4))
    (vla-SetCellAlignment table r 1 acMiddleCenter)
    (vla-SetValueFromText table r 2 1 (rtos (caddr data) 2 8) acParseOptionNone)
    (vla-SetCellTextHeight table r 2 (/ (/ (- (cadr ul) (cadr lr)) (+ 2 (length datalst))) 4))
    (vla-SetCellAlignment table r 2 acMiddleCenter)
    (vla-SetValueFromText table r 3 1 (vl-string-translate "d" (chr 176) (angtos (cadddr data) 1 2)) acParseOptionNone)
    (vla-SetCellTextHeight table r 3 (/ (/ (- (cadr ul) (cadr lr)) (+ 2 (length datalst))) 4))
    (vla-SetCellAlignment table r 3 acMiddleCenter)
  )
  (alert "HIT ENTER TO POP UP DIALOG BOX WITH CSV FILE - SELECT \"ARCLABELTABLE.CSV\" AND PRESS CTRL+C THEN ENTER")
  (getfiled "SELECT \"ARCLABELTABLE.CSV\" AND PRESS CTRL+C THEN ENTER" (getvar 'dwgprefix) "csv" 16)
  (alert "HIT ENTER TO POP UP DIALOG BOX WHERE YOU CAN CHOOSE PASTE OR BETTER LINK OPTION THEN ENTER TO CONTINUE")
  (command "_.PASTESPEC")
  (while (< 0 (getvar 'cmdactive))
    (command "\\")
  )
  (startapp "EXPLORER" csvf)
  (*error* nil)
)

M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)
Report
0 Likes
Reply
Message 4 of 4
kzD1219
Collaborator
in reply to: marko_ribar
‎04-05-2016 05:27 AM
‎04-05-2016 05:27 AM

Wow, thanks for all the work.  I have loaded it, but I can't seem to get past the first question:

Specify ARCs label prefix (case sensitive).  Not quite sure what to put there, would it be A for Arc or C for the curve I have labelled or something else?

 

Thanks

 

Report
0 Likes
Reply
Reply

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Customer Advisory Groups


Autodesk Design & Make Report

Report a website issue