I can construct a basic table, but I'm not sure how to make a table border. I have tried multiple variations of code to no avail.
(list 'table ;this is where I tried border attributes
(list 'tr
(list 'th "Key")
(list 'th "Value")
)
(list 'tr
(list 'td "A")
(list 'td "Blue")
)
(list 'tr
(list 'td "B")
(list 'td "Gold")
)
I'm not sure of the syntax for border, or the attributes that can be defined. I'm just trying to cram HTML tags into Racket with very little direction. I have tried:
'border 1
(list 'border 1
'border 1 solid black
and variations of the above.
I did some more tinkering and came up with:
(list 'table
(list
(list 'border "1"))
(list 'tr
(list 'th "Key")
(list 'th "Value")
)
(list 'tr
(list 'td "A")
(list 'td "Blue")
)
(list 'tr
(list 'td "B")
(list 'td "Gold")
)
)
)
Which displays a 1px border around the table/rows/columns.
Related
I have to write the function that determines the number and values of block attributes in AutoLisp.
I have function which count the atributes:
(defun c:Test (/ s ss)
(if (and (princ "\n Select FIRST Attributed Block :")
(setq s (ssget "_+.:S:E" '((0 . "INSERT") (66 . 1))))
(princ "\n Select the SECOND Attributed Block :")
(setq ss (ssget "_+.:S:E" '((0 . "INSERT") (66 . 1))))
)
(mapcar
'length
(mapcar
'(lambda (a)
(mapcar
'(lambda (x) (vla-get-textstring x))
(vlax-invoke (vlax-ename->vla-object a) 'getattributes)
)
)
(list (ssname s 0) (ssname ss 0))
)
)
)
)**
A function that returns the values of attributes:
(defun c:Test (/ ss n e x)
(while (progn (princ "\n Select single attributed block :")
(setq ss (ssget "_+.:S" '((0 . "INSERT") (66 . 1))))
)
(setq n (entnext (ssname ss 0)))
(while (not (eq (cdr (assoc 0 (setq e (entget n)))) "SEQEND" ))
(if (eq (cdr (assoc 0 e)) "ATTRIB")
(print (cdr (assoc 1 e)))
)
(setq n (entnext n))
)
)
(princ)
)
Could you help me to combine this to functions into one?
Here is a lisp program that will loop over all blocks from a user selection set and:
1.) print block name
2.) print the association list of AttributeTag.AttributeValue
3.) print the list of AttributeTags
4.) print the list of AttributeValues
5.) print the number of AttributeValues
I also attached what the command line output should look like.
Lisp command line output
;;www.cadwiki.net
(defun c:test (/ SSINPUT)
(setq ssInput (ssget (list '(0 . "insert"))))
(PRINT-BLOCK-ATTRIBUTE-INFO ssInput)
(princ)
)
(defun PRINT-BLOCK-ATTRIBUTE-INFO (ssInput / ATTRIBUTETAGS ATTRIBUTETAGSTOVALUES ATTRIBUTEVALUES BLOCKENTITY BLOCKVLAOBJECT I NUMBEROFBLOCKATTRIBUTES
)
(setq i 0)
(if (= ssInput nil)
(progn
(princ "ssInput was nothing, exiting.")
(exit)
)
)
(princ (strcat "\nItems in selection set: " (itoa (sslength ssInput))))
(while (< i (sslength ssInput))
(setq blockEntity (ssname ssInput i))
(setq blockVlaObject (vlax-ename->vla-object blockEntity))
(setq attributeTagsToValues (GET-BLOCK-ATTRIBUTE-NAME-TO-VALUE-ASSOC blockEntity))
(princ (strcat "\nBlock name: " (vla-get-name blockVlaObject)))
(princ "\nBlock attributes tag to values association list: ")
(princ attributeTagsToValues)
(setq attributeTags (GET-NTHS-FROM-LISTS 0 attributeTagsToValues nil))
(princ "\nBlock attribute tags list: ")
(princ attributeTags)
(setq attributeValues (GET-LAST-ITEM-FROM-EACH-LIST attributeTagsToValues))
(princ "\nBlock attributes values list: ")
(princ attributeValues)
(princ "\nNumber of block attributes: ")
(setq numberOfBlockAttributes (itoa (length attributeValues)))
(princ numberOfBlockAttributes)
(setq i (+ i 1))
)
)
(defun GET-NTHS-FROM-LISTS (N LSTs removeDuplicates / CT LST2 LST IT)
(setq LST2 nil)
(foreach LST LSTs
(setq IT (nth N LST))
(if removeDuplicates
(if (not (member IT LST2))
(setq LST2 (append LST2 (list IT)))
)
(setq LST2 (append LST2 (list IT)))
)
)
LST2
)
(defun GET-LAST-ITEM-FROM-EACH-LIST (LSTs / CDRs FAIL LST)
(setq CDRs nil
FAIL nil
)
(if (not (= (type LSTs) 'LIST))
(setq FAIL "not a list")
)
(if (not FAIL)
(foreach LST LSTs
(setq FAIL (cond
((not (= (type LST) 'LIST)) "non-list member")
((not (cdr LST)) "no CDR")
(T nil)
)
)
(if (not FAIL)
(setq CDRs (append CDRs (list (cdr LST))))
)
)
)
CDRs
)
(defun GET-BLOCK-ATTRIBUTE-NAME-TO-VALUE-ASSOC (entity / COUNTER COUNTER2 COUNTERMAX COUNTERMAX2 DXFCODE0 DXFCODE2 DXFCODE66 DXFCODE8 DXFCODECODE-1 ENTITIESTORETURN ENTITYDXFCODES *ERROR* RETURNLIST
SUPPLIEDTRUENAME TRUENAME ATTRIBUTETAG ATTRIBUTEVALUE DXFCODE-1 ENTITYNAMEFORDRILLING SUBLIST TAGSANDVALUES THECALLINGFUNCTIONSNAME
)
(setq counter 0) ;initialize counter to 0 for while loop
(if ;if
(/= entity nil) ;entity is not nil
(progn ;progn wrap
(setq entityDxfCodes (entget entity)) ;set the varaible entityDxfCodes to the list of entities from the en varaible
;; you can use the method here to find any value from a dxfCodecode
(setq dxfCode-1 (cdr (assoc -1 entityDxfCodes))) ;set dxfCode-1 to the second element of the item that has -1 as it's first element, this is the entity name
(setq dxfCode0 (cdr (assoc 0 entityDxfCodes))) ;set dxfCode0 to the element of the item that has 0 as it's first element, this is the entity type
(setq dxfCode2 (cdr (assoc 2 entityDxfCodes))) ;set dxfCode8 to the second element of the item that has 8 as it's first element, this is the name, or block name
(setq dxfCode8 (cdr (assoc 8 entityDxfCodes))) ;set dxfCode8 to the second element of the item that has 8 as it's first element, this is the layer
(setq dxfCode66 (cdr (assoc 66 entityDxfCodes))) ;set dxfCode66 to the second element of the item that has 66 as it's first element, this is the attribute flag
(setq entityNameForDrilling entity)
(if ;if start
(= dxfCode66 1) ;entity attribute flag is 1
(progn ;progn wrap
(while (/= dxfCode0 "SEQEND") ;while loop to drill to each sub entity in a block
(setq attributeTag (cdr (assoc 2 entityDxfCodes))) ;set attributeTag to the second element of the second Dxf code (assoc 2) of the entityDxfCodes variable
(setq attributeValue (cdr (assoc 1 entityDxfCodes))) ;set attributeValue to the second element of the first Dxf code (assoc 1) of the entityDxfCodes variable
(if
(/= attributeValue nil)
(progn
(setq sublist (cons attributeTag attributeValue))
(setq tagsAndValues (cons sublist TagsAndValues))
)
)
(setq entityNameForDrilling (entnext entityNameForDrilling))
(setq entityDxfCodes (entget entityNameForDrilling))
(setq dxfCode0 (cdr (assoc 0 entityDxfCodes)))
)
) ;progn wrap end
) ;if end
) ;progn wrap end
) ;if end
(setq returnList tagsAndValues)
)
I am confused about where I got wrong in translating this diagram into Racket code using "list" notation.
For the code, I wrote
(list 'greetings
(list 'howdy 'hi "hello")
(list "yo" 0.7734
(list 'hola 'bonjour)))
But it turns out that this code is incorrect. I looked up the list notation definition but I couldn't find what's wrong. Could anyone give me a hint about where I got wrong? Greatly appreciated!
The "yo", 0.7734, and (list 'hola 'bonjour) belong to the top level list:
(define sublist1 (list 'howdy 'hi "hello"))
(define sublist2 (list 'hola 'bonjour))
(list 'greetings sublist1 "yo" 0.7734 sublist2)
(list 'greetings (list 'howdy 'hi "hello") "yo" 0.7734 (list 'hola 'bonjour))
(define CHAR-CANVAS%
(class canvas%
(define/override (on-char evt)
(let ((c (send evt get-key-code)) (dc(send this get-dc)))
(send dc clear)
(print c)
(cond
((equal? c 'release)(void))
((member c '( #\a #\i #\u #\e #\o #\q #\é #\x))
(begin(set! tampon-key (cons c tampon-key)) (send dc draw-text (cadr (member (list->string (reverse tampon-key)) alphabet )) 30 30)
(send R-k-text insert (cadr (member (list->string (reverse tampon-key)) alphabet ))) (set! tampon-key '())))
((equal? c #\;)(begin(send R-k-text insert "。") (set! tampon-key '())))
((equal? c #\,)(begin(send R-k-text insert "、") (set! tampon-key '())))
((equal? c #\()(begin(send R-k-text insert "「") (set! tampon-key '())))
((equal? c #\))(begin(send R-k-text insert " 」") (set! tampon-key '())))
((equal? c #\&)(begin(send R-k-text insert "々") (set! tampon-key '())))
((not(member c '(#\b #\c #\d #\f #\g #\j #\k #\m #\n #\p #\r #\i #\h #\t #\s #\w #\y #\a #\e #\o #\z #\u)))(void))
((begin (set! tampon-key (cons c tampon-key))(print tampon-key))))
))
(super-new)))
It works very well (it is for writing in hiragana katakana and other characters)
I want to add to this same canvas
a feature which tells me the position of the cursor on a text
is it possible? if yes
what is the code to add?
(define/override (on-char evt)......
Or do I need a another canvas?
in this case what will be my code?
(define/override (on-char evt)......
this in order to do something similar to a "RIKAICHAN"
(define (transform-syll->mot L-romanji L-hiragana)
(let ((a '())(b'()))
(set! a (map list->string (reverse L-romanji)))
(set! b (map char->string (string->list "たべます")))
(list a b)))
(define (foo-w1 tw) ;transforme syllabe en fichier wav (if exist)
(let ((l '()))
(while (not (null? tw))
(set! l(cons (string-append (car tw )".wav")l))
(set! tw (cdr tw)))
(reverse l)))
(define (transform-mot->son L-romanji L-hiragana)
(let* ((x (transform-syll->mot L-romanji L-hiragana))
(a (car x)))
(current-directory "/Users/izuko/Desktop/japonais-new/jap-syll")
(rs-append* (map rs-read (foo-w1 a)))))
(define syllabe-R '())
(define syllabe-H '())
(define clip "")
(define Bt-dir
(new button%
(parent GP-1 )
(label "Direct")
(callback (lambda (obj evt)
(begin (set! alphabet hiragana)
(set! lecture-feld (send R-k-tex-rech get-text))
(set! LECT-HI* (cons lecture-feld LECT-HI*))
(set! LECT-ID* (cons lecture-feld LECT-ID*))
(send R-k-text insert lecture-feld)
(set! syllabe-R (transform-syll->mot tampon-wort lecture-feld))
(set! clip (transform-mot->son tampon-wort lecture-feld))
(play clip))))))
My intent is to create some lines having two texts each with short info (made as a group), and letting the reactor assigned to the line making sure that:
When copied, the handles of each entity will get updated with the info of the others and
In case I stretch the line using the end grip, the line reactor will update the length of the line as stored xdata and updating the text value that corresponds to the length.
So far and with the valuable help of this forum I was able to make it with the copy part of the story. When I try to incorporate the 'modified' option in the reactor, it does not work. Below is the code I use.
The first function assigns the reactor to the line during its creation through an other function, not shown here. The rest are callbacks and so on. Any suggestions appreciated.
In continuation to this question:
How to update xdata information of an entity when it is copied
(defun assign_LLreactor (LL_ename LL_Length LL_Size / LL_ename LL_hLength LL_hSize)
(if (= 'vlr-object-reactor (type lineReactor))
(vlr-owner-add lineReactor (vlax-ename->vla-object LL_ename))
(vlr-set-notification
(setq lineReactor
(vlr-object-reactor (list (vlax-ename->vla-object LL_ename)) "Line Reactor"
'(
(:vlr-modified . LL_callback_mod)
(:vlr-copied . LL_callback)
)
)
)
'active-document-only
)
)
(makeagroup (ssadd (handent LL_Length) (ssadd (handent LL_Size) (ssadd LL_ename (ssadd)))))
)
(defun LL_callback (notifierobj reactorobj paramls)
(if (/= 0 (car paramls))
(progn
(setq LL_owner (append LL_owner (list (car paramls))))
(vlr-command-reactor "LL_copied_re"
'(
(:vlr-commandended . LL_copyended)
(:vlr-commandcancelled . LL_copycancelled)
(:vlr-commandfailed . LL_copycancelled)
)
)
)
)
)
(defun LL_callback_mod (owner reactorobj paramls)
(setq LL_owner (append LL_owner (list owner)))
(vlr-command-reactor "LL_modified_re"
'(
(:vlr-commandended . LL_modifiedended)
(:vlr-commandcancelled . LL_modifiedcancelled)
(:vlr-commandfailed . LL_modifiedcancelled)
)
)
)
(defun LL_copyended ( reactor params / enametxt txt1 txt2 hSize hLength groupedentities txthandles grtxtdata)
(vlr-remove reactor)
(if
(and
(setq LL_ent (car LL_owner))
(setq LL_enx (entget LL_ent '("LL_U")))
(= (cdr (assoc 0 LL_enx)) "LINE")
(setq LL_3data (assoc -3 LL_enx))
)
(progn
(foreach n (setq groupedentities (_groupedenames LL_ent))
(if (= (cdr (assoc 0 (setq grtxtdata (entget n '("LL_U"))))) "TEXT")
(progn
(setq txthandles (append txthandles (list (cdr (assoc 5 grtxtdata)))))
(entmod (subst (list -3 (list "LL_U" (cons 1005 (cdr (assoc 5 LL_enx))))) (assoc -3 grtxtdata) grtxtdata))
)
)
)
(setq txthandles (vl-sort txthandles (function (lambda (a b) (< a b)))))
(entmod (subst (list -3 (list "LL_U" (cons 1005 (cadr txthandles)) (cons 1005 (car txthandles)))) (assoc -3 LL_enx) LL_enx))
)
)
(if (and LL_enx (= 'vlr-object-reactor (type lineReactor)))
(vlr-owner-add lineReactor (vlax-ename->vla-object LL_ent))
)
(setq LL_owner (cdr LL_owner))
(princ)
)
(defun LL_modifiedended ( reactor params / LL_ent LL_enx llpt10 llpt11 LL_3data LL_3data_n)
(if
(and
(setq LL_ent (car LL_owner))
(setq LL_enx (entget LL_ent '("Pdata")))
(= (cdr (assoc 0 LL_enx)) "LINE")
(setq LL_3data (assoc -3 LL_enx))
)
(progn
(if (= 'vlr-object-reactor (type lineReactor))
(vlr-remove lineReactor)
)
(setq llpt10 (cdr (assoc 10 LL_enx)))
(setq llpt11 (cdr (assoc 11 LL_enx)))
(setq LL_3data_n (list -3 (subst (cons 1000 (rtos (distance llpt10 llpt11) 2 3)) (nth 2 (cadr LL_3data)) (cadr LL_3data))))
(ht_ss (ssadd (cdr (assoc -1 (entmod (subst LL_3data_n (assoc -3 LL_enx) LL_enx)))) (ssadd)))
(if (= 'vlr-object-reactor (type lineReactor))
(vlr-add lineReactor)
)
)
)
(princ)
)
(defun LL_copycancelled ( reactor params )
(vlr-remove reactor)
(setq LL_owner nil)
(princ)
)
(defun LL_modifiedcancelled ( reactor params )
(vlr-remove reactor)
(setq LL_owner nil)
(princ)
)
I expect the object reactor works well for both 'modified' and 'copied' action for lines being either stretched or copied with updated xdata and texts.
So I managed to solve the issue by utilizing a separate list for the owners of the specific reactor type (e.g. 'copied' or 'modified'). So 'LL_owner' list became two, 'LL_copy_owner' and 'LL_mod_owner'. Now it works fine (until further notice :).
I use 2 methods to build a tree based on cons cells.
(defun make-tree (nodes)
(cons nodes NIL))
(defun add-child (tree child)
(setf (cdr tree) (append (cdr tree) child)))
Then I created 4 parameters:
(defparameter *root* (make-tree "root"))
(defparameter *a* (make-tree "a"))
(defparameter *b* (make-tree "b"))
(defparameter *c* (make-tree "c"))
And I construct the following tree:
(add-child *root* *a*)
(add-child *root* *b*)
(add-child *a* *c*)
The *root* is displayed in the console:
CL-USER> *root*
("root" "a" "b")
My question is: Is it possible to retrieve c from *root*? Something like: (cdr (car (cdr *root*))) returns an error.
You need to use NCONC rather than APPEND in ADD-CHILD, so you don't make copies of the subtrees.
(defun add-child (tree child)
(setf (cdr tree) (append (cdr tree) child)))
With this change, after I do all the other steps, I get:
> *root*
("root" "a" "b" "c")
> (car (cdr (cdr (cdr *root*))))
"c"
> (cadddr *root*)
"c"