Community

Text and tables lisp

Text and tables lisp

kzD1219
Collaborator Collaborator
1,349 Views
3 Replies
Message 1 of 4

Text and tables lisp

kzD1219
Collaborator
Collaborator
‎04-01-2016 06:44 AM

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
0 Likes
Like
Report
1,350 Views
3 Replies
Replies (3)
Message 2 of 4

marko_ribar
Advisor
Advisor
‎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)
0 Likes
Like
Report
Message 3 of 4

marko_ribar
Advisor
Advisor
in reply to marko_ribar
‎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)
0 Likes
Like
Report
Message 4 of 4

kzD1219
Collaborator
Collaborator
in reply to marko_ribar
‎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

 

0 Likes
Like
Report
Report a website issue