Leaderboard

And the angular units and accuracy?

OK. Amended Lisp. I've removed the local *error* and adjusted the ssget. Tested and working on your test drawing. As before you can adjust the text and point layers in the User Settings (setq). The same color is used for the bottom text and points (3) and the top text and points (6) (defun c:tbk ( / c_doc c_lyrs sv_lst sv_vals bok_lyr bc tok_lyr tc bkp_lyr tkp_lyr ss cnt ent elst typ i_pt tlst plst aent bent) (setq c_doc (vla-get-activedocument (vlax-get-acad-object)) c_lyrs (vlax-get-property c_doc 'layers) sv_lst (list 'cmdecho 'osmode) sv_vals (mapcar 'getvar sv_lst) );end_setq ;; User Settings (setq bok_lyr "Bottom_Kerb" bc 3 ;Bottom of Kerb Layer and color tok_lyr "Top_Kerb" tc 6 ;Top of Kerb Layer and color bkp_lyr "Kerb_Point_Top" ;Top of Kerb Point Layer tkp_lyr "Kerb_Point_Bottom" ;Bottom of Kerb Point Layer );end_setq (cond ( (not (tblsearch "layer" bok_lyr)) (vla-add c_lyrs bok_lyr) (vlax-put (vla-item c_lyrs bok_lyr) 'color bc))) (cond ( (not (tblsearch "layer" tok_lyr)) (vla-add c_lyrs tok_lyr) (vlax-put (vla-item c_lyrs tok_lyr) 'color tc))) (cond ( (not (tblsearch "layer" bkp_lyr)) (vla-add c_lyrs bkp_lyr) (vlax-put (vla-item c_lyrs bkp_lyr) 'color bc))) (cond ( (not (tblsearch "layer" tkp_lyr)) (vla-add c_lyrs tkp_lyr) (vlax-put (vla-item c_lyrs tkp_lyr) 'color tc))) (setq ss (ssget '((0 . "POINT,MTEXT") (8 . "POINT,LEVEL")))) (cond (ss (repeat (setq cnt (sslength ss)) (setq elst (entget (setq ent (ssname ss (setq cnt (1- cnt))))) typ (cdr (assoc 0 elst)) );end_setq (if (= typ "POINT") (setq plst (cons (list (cdr (assoc 10 elst)) ent) plst)) (setq tlst (cons (list (cdr (assoc 10 elst)) ent) tlst))) );end_repeat (setq i_pt (caar tlst) tlst (vl-sort tlst '(lambda (x y) (< (distance i_pt (car x)) (distance i_pt (car y))))) plst (vl-sort plst '(lambda (x y) (< (distance i_pt (car x)) (distance i_pt (car y))))) );end_setq (while tlst (setq aent (cadr (car tlst)) bent (cadr (cadr tlst)) tlst (cddr tlst)) (cond ( (> (atof (cdr (assoc 1 (entget aent)))) (atof (cdr (assoc 1 (entget bent))))) (vlax-put (vlax-ename->vla-object aent) 'layer tok_lyr) (vlax-put (vlax-ename->vla-object bent) 'layer bok_lyr) ) (t (vlax-put (vlax-ename->vla-object aent) 'layer bok_lyr) (vlax-put (vlax-ename->vla-object bent) 'layer tok_lyr) ) );end_cond );end_while (while plst (setq aent (cadr (car plst)) bent (cadr (cadr plst)) plst (cddr plst)) (cond ( (> (caddr (cdr (assoc 10 (entget aent)))) (caddr (cdr (assoc 10 (entget bent))))) (vlax-put (vlax-ename->vla-object aent) 'layer tkp_lyr) (vlax-put (vlax-ename->vla-object bent) 'layer bkp_lyr) ) (t (vlax-put (vlax-ename->vla-object aent) 'layer bkp_lyr) (vlax-put (vlax-ename->vla-object bent) 'layer tkp_lyr) ) );end_cond );end_while ) (t (alert "Nothing Found")) );end_cond (mapcar 'setvar sv_lst sv_vals) (princ) );end_defun

DO IT YOURSELF !! look at your "thkl sua.lsp" , just add (c:BTH) at the last line before (princ) look at BTH update p/s: you can copy paste all BTH in your "thkl sua.lsp"

In the Vietnamese dictionary: "hanhphuc" is equivalent to "Happy". Thanks you very much !

you must load your "thkl sua.lsp" command THKL to select region to create AcTable "Bang tong hop" at the first place! after done Table command BTH to pick the newly created "Bang tong hop" table then place result.

It does not match the requirements because this is your assignment not others! since AcTable "Bang Tong Hop" is not formatted text quick & dirty 1.populate value/text from Table "Bang Tong Hop" 2.filter 3 list use cond matched criteria 3.sum each list 4.put MText at Reinforced Statistics Table (defun c:BTH (/ 10<?<18 ?<=10 ?>18 en l pt foo ) (defun foo (l / ls) (if l (setq ls (cons (list (car l) (cadr l) (caddr l) (cadddr l)) (foo (setq l (cddddr l))) ) ) ) ls ) (if (and (setq en (car (entsel "\nPick Table Bang tong hop.. "))) (= (cdr (assoc 0 (entget en))) "ACAD_TABLE") (setq l (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 1)) (entget en) ) ) ) (= (car l) "Bang tong hop") ;remove header ("STT" "DK" "CD" "KL") (foreach x (cdr (foo (cdr l))) (cond ((<= (distof (cadr x)) 10) (setq ?<=10 (cons (distof (cadddr x)) ?<=10)) ) ((< 10 (distof (cadr x)) 18) (setq 10<?<18 (cons (distof (cadddr x)) 10<?<18)) ) ((>= (distof (cadr x)) 18) (setq ?>18 (cons (distof (cadddr x)) ?>18)) ) (t) ) ) ) (or (and (setq pt (getpoint "\nPick 1st KL cell at Reinforced Statistic table " ) ) (entmakex (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText") '(50 . 0) (cons 40 0.6) (cons 10 (trans pt 1 0)) (cons 1 (apply 'strcat (mapcar '(lambda(x) (if x (strcat (rtos (apply '+ x ) 2 2) "\\P") ) ) (list ?<=10 10<?<18 ?>18) ) ) ) ) ) ) (princ "\nInvalid point!!") ) (alert "Invalid Bang Tong Hop AcTable!\nPlease try again! ") ) (princ) )

There was an issue with number of vertices also... Hopefully now fixed that too... Regards, M.R.

XOR means that it matches any one of the conditions set, but not all of it. You'll have to use the AND operator as Lee stated if you'd want to use conditional operators:

If think people are heading in wrong direction to many years in CIVIL, if you look more carefully at the dwg there are 2 Field survey "Points" these have a Z value. Top and bottom of kerb. The 1st step is what type of kerb just because there are 2 points does not reveal a kerb type in this case its around 150 so this for me would suggest a "B1" ok some kerb types B1 Backofkerb, Faceofkerb, Bottomofkerb 150mm wide B2 Backofkerb, Faceofkerb, Invert, Lipofkerb 450mm wide The white line is a red herring and it basically is a line between the points so then end required result is two 3dlines joining the "Points", a solution is to walk along the white line looking for points then join lowest and highest at each location so get a true kerb. If these points were say a csv then it would be possible to join them automatically if they have a "Code" attached to each point PNEZC is a typical csv. Just need some time have some actual work to do 1st. Ps some issues point surveyed order left and right may not be in same order so sort 2 lists X&Y must have 2 points else compare dist and stop as missing points.

OK. First attempt. This seems to work having tested in various orientations. You can set your own layers and colors for top of kerb and bottom of kerb in the user settings (setq) (if the layers don't exist they are created and the color set) It assumes all the MTEXT items are on layer LEVEL. There are no checks for matching pairs. (defun c:tbk ( / *error* c_doc c_lyrs sv_lst sv_vals bok_lyr bc tok_lyr tc ss cnt ent elst typ i_pt lst aent bent) (defun *error* ( msg ) (mapcar 'setvar sv_lst sv_vals) (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred."))) (princ) );end_*error*_defun (setq c_doc (vla-get-activedocument (vlax-get-acad-object)) c_lyrs (vlax-get-property c_doc 'layers) sv_lst (list 'cmdecho 'osmode) sv_vals (mapcar 'getvar sv_lst) );end_setq ;; User Settings (setq bok_lyr "Bottom_Kerb" bc 3 ;Bottom of Kerb Layer and color tok_lyr "Top_Kerb" tc 6 ;Top of Kerb Layer and color );end_setq (cond ( (not (tblsearch "layer" bok_lyr)) (vla-add c_lyrs bok_lyr) (vlax-put (vla-item c_lyrs bok_lyr) 'color bc))) (cond ( (not (tblsearch "layer" tok_lyr)) (vla-add c_lyrs tok_lyr) (vlax-put (vla-item c_lyrs tok_lyr) 'color tc))) (setq ss (ssget "_X" '((0 . "MTEXT") (8 . "LEVEL")))) (cond (ss (repeat (setq cnt (sslength ss)) (setq elst (entget (setq ent (ssname ss (setq cnt (1- cnt))))) typ (cdr (assoc 0 elst)) lst (cons (list (cdr (assoc 10 elst)) ent) lst) );end_setq );end_repeat (setq i_pt (caar lst) lst (vl-sort lst '(lambda (x y) (< (distance i_pt (car x)) (distance i_pt (car y))))) ) (while lst (setq aent (cadr (car lst)) bent (cadr (cadr lst)) lst (cddr lst)) (cond ( (> (atof (cdr (assoc 1 (entget aent)))) (atof (cdr (assoc 1 (entget bent))))) (vlax-put (vlax-ename->vla-object aent) 'layer tok_lyr) (vlax-put (vlax-ename->vla-object bent) 'layer bok_lyr) ) (t (vlax-put (vlax-ename->vla-object aent) 'layer bok_lyr) (vlax-put (vlax-ename->vla-object bent) 'layer tok_lyr) ) );end_cond );end_while ) (t (alert "Nothing Found")) );end_cond (mapcar 'setvar sv_lst sv_vals) (princ) );end_defun

Hi btsai, Please try codes below showing some methods of extracting data from ProSteel groups, hope they are useful for you. Dump all available properties: (defun C:DumpItG ( / ent) (setq ent (entsel)) (setq acadapp (vlax-get-acad-object)) (setq groupinfo (vla-getinterfaceobject acadapp "PSCOMWRAPPER.Ks_ComGroupProperty" )) (vlax-invoke-method groupinfo 'ReadFrom (vlax-ename->vla-object (car ent))) (vlax-Dump-Object groupinfo ) (textscr) (princ) ) Example of extracting each property to variable: (defun c:GroupProperty ( ) (vl-load-com) (setq acadapp (vlax-get-acad-object)) (setq groupinfo (vla-getinterfaceobject acadapp "PSCOMWRAPPER.Ks_ComGroupProperty" )) (setq ent (entsel "\nSelect group: " )) (setq ent (car ent)) (vlax-invoke-method groupinfo 'ReadFrom (vlax-ename->vla-object ent)) (setq Count (vlax-get-property groupinfo 'Count)) (setq DetailStyleId (vlax-get-property groupinfo 'DetailStyleId)) (setq DontDetailFlag (vlax-get-property groupinfo 'DontDetailFlag)) (setq FamilyClass (vlax-get-property groupinfo 'FamilyClass)) (setq GroupHeight (vlax-get-property groupinfo 'GroupHeight)) (setq GroupLength (vlax-get-property groupinfo 'GroupLength)) (setq GroupPaintArea (vlax-get-property groupinfo 'GroupPaintArea)) (setq GroupWeight (vlax-get-property groupinfo 'GroupWeight)) (setq GroupWidth (vlax-get-property groupinfo 'GroupWidth)) (setq IsMainPart (vlax-get-property groupinfo 'IsMainPart)) (setq ItemNumber (vlax-get-property groupinfo 'ItemNumber)) (setq Name (vlax-get-property groupinfo 'Name)) (setq NameChangedManually (vlax-get-property groupinfo 'NameChangedManually)) (setq Note1 (vlax-get-property groupinfo 'Note1)) (setq Note2 (vlax-get-property groupinfo 'Note2)) (setq OriginalPosNumber (vlax-get-property groupinfo 'OriginalPosNumber)) (setq PartlistFlag (vlax-get-property groupinfo 'PartlistFlag)) (setq PosNumber (vlax-get-property groupinfo 'PosNumber)) (setq PosNumberChangedFlag (vlax-get-property groupinfo 'PosNumberChangedFlag)) (setq ShipNumber (vlax-get-property groupinfo 'ShipNumber)) (setq TotalCount (vlax-get-property groupinfo 'TotalCount)) (princ "\n") (princ Count ) (princ "\n") (princ DetailStyleId ) (princ "\n") (princ DontDetailFlag ) (princ "\n") (princ FamilyClass ) (princ "\n") (princ GroupHeight ) (princ "\n") (princ GroupLength ) (princ "\n") (princ GroupPaintArea ) (princ "\n") (princ GroupWeight ) (princ "\n") (princ GroupWidth ) (princ "\n") (princ IsMainPart ) (princ "\n") (princ ItemNumber ) (princ "\n") (princ Name ) (princ "\n") (princ NameChangedManually ) (princ "\n") (princ Note1 ) (princ "\n") (princ Note2 ) (princ "\n") (princ OriginalPosNumber ) (princ "\n") (princ PartlistFlag ) (princ "\n") (princ PosNumber ) (princ "\n") (princ PosNumberChangedFlag ) (princ "\n") (princ ShipNumber ) (princ "\n") (princ TotalCount ) ;(setq vObje (vlax-ename->vla-object ent));Bolt ;(vlax-put-property groupinfo 'Name "TEST") ;(princ (strcat (rtos count 2 0) " - " name)) (princ) )

Thanks Lee! +2,147,483,647 to -2,147,483,648 p/s: rgb reminds me UTF-8 time flies! 4.18? cheers guru

Hint: integers in AutoLISP are represented using signed 32-bit integers, unsigned integers aren't available.

Thanks from wiki , ARGB max A is FF, but my test in CAD max just reach 7F?? ;;https://en.wikipedia.org/wiki/RGBA_color_model (defun wiki:rgb (lst) ((lambda (i) (apply 'logior (mapcar '(lambda (x) (lsh (fix x) (setq i (- i 8)))) lst) ) ) (* (length lst ) 8) ) ) ;eg ;(wiki:rgb (list 45 89 142)) ;2972046 example : R,G,B,A = 45,89,142,127 (mapcar 'set '(r g b a) '(45 89 142 127)) (LM:dec->hex (wiki:rgb (list a r g b)) ) "7F2D598E" --> AGRB but if A>127, i.e: (128 ~ 255 ) "¾" ??? maybe concatenate either "A+RGB " or "RGB+A" in ARGB case if A=128 (apply 'strcat (mapcar ''((x) (LM:dec->hex x)) (list 128 (wiki:rgb (list r g b))) ) )

I imagine that the OP is not using the output to set transparency in AutoCAD, but for some other application which uses RGBA colour coding.