Jump to content

All Activity

This stream auto-updates

  1. Past hour
  2. @GLAVCVS thank you very much for the 2 options, I like both options, but the first option suits me better.
  3. Today
  4. If you don't want the command to end after editing the text, you can keep the "while" loop, as shown in this other code. The operation will be the same except that to exit the command, you'll need an additional "right click." (defun c:TEcolor136_230 (/ error oldcmdecho sel e typo obj res currentColor para) (vl-load-com) (defun error (msg) (if oldcmdecho (setvar "CMDECHO" oldcmdecho) ) (if (and msg (not (wcmatch (strcase msg) "BREAK,CANCEL,EXIT"))) (princ (strcat "Error: " msg)) ) (princ) ) (setq oldcmdecho (getvar "CMDECHO")) (setvar "CMDECHO" 0) (while (setq sel (entsel "\nSelect TEXT/MTEXT to edit (Enter — exit): ")) (setq ;sel (entsel "\nSelect TEXT/MTEXT to edit (Enter — exit): ") e (car sel) typo (strcase (cdr (assoc 0 (entget e)))) ) (if (wcmatch typo "TEXT,MTEXT") (progn (setq obj (vlax-ename->vla-object e)) ;; get the current color (setq currentColor (vl-catch-all-apply 'vlax-get-property (list obj 'Color)) ) ;; Error handling on receipt (if (vl-catch-all-error-p currentColor) (setq currentColor 0) ) ;; Opening the text editor (getstring) (setq res (vl-catch-all-apply 'vl-cmdf (list "_.textedit" e "")) ) ;;; (if (/= (setq res (getstring (strcat "\nEdit text <" (cdr (assoc 1 (entget e))) ">: "))) "") ;;; (entmod (subst (cons 1 res) (assoc 1 (entget e)) (entget e))) ;;; ) (if (vl-catch-all-error-p res) (princ "Editing canceled.") ;; After editing, we change the color (progn (if (= currentColor 136) ;; If it's 136, change it to 230. (if (vl-catch-all-error-p (vl-catch-all-apply 'vlax-put-property (list obj 'Color 230) ) ) (princ "Couldn't change color to 230.") (princ "The color has been changed to 230.") ) ) (if (/= currentColor 136) ;; If it's not 136, change it to 136. (if (vl-catch-all-error-p (vl-catch-all-apply 'vlax-put-property (list obj 'Color 136) ) ) (princ "Couldn't change the color to 136.") (princ "The color has been changed to 136.") ) ) (princ "Editing completed.") ) ) ) (princ "It's not an object TEXT/MTEXT.") ) ) (setvar "CMDECHO" oldcmdecho) (princ) )
  5. I hope the 'textedit' options in your version of AutoCAD aren't a problem.
  6. There's another option: to respect the call to 'textedit' and exit it by clicking the mouse over the empty background. This is the option applied in the attached code. (defun c:TEcolor136_230 (/ error oldcmdecho sel e typo obj res currentColor para) (vl-load-com) (defun error (msg) (if oldcmdecho (setvar "CMDECHO" oldcmdecho) ) (if (and msg (not (wcmatch (strcase msg) "BREAK,CANCEL,EXIT"))) (princ (strcat "Error: " msg)) ) (princ) ) (setq oldcmdecho (getvar "CMDECHO")) (setvar "CMDECHO" 0) ;;; (while (setq sel (entsel "\nSelect TEXT/MTEXT to edit (Enter — exit): ")) (setq sel (entsel "\nSelect TEXT/MTEXT to edit (Enter — exit): ") e (car sel) typo (strcase (cdr (assoc 0 (entget e)))) ) (if (wcmatch typo "TEXT,MTEXT") (progn (setq obj (vlax-ename->vla-object e)) ;; get the current color (setq currentColor (vl-catch-all-apply 'vlax-get-property (list obj 'Color)) ) ;; Error handling on receipt (if (vl-catch-all-error-p currentColor) (setq currentColor 0) ) ;; Opening the text editor (getstring) (setq res (vl-catch-all-apply 'vl-cmdf (list "_.textedit" e "")) ) ;;; (if (/= (setq res (getstring (strcat "\nEdit text <" (cdr (assoc 1 (entget e))) ">: "))) "") ;;; (entmod (subst (cons 1 res) (assoc 1 (entget e)) (entget e))) ;;; ) (if (vl-catch-all-error-p res) (princ "Editing canceled.") ;; After editing, we change the color (progn (if (= currentColor 136) ;; If it's 136, change it to 230. (if (vl-catch-all-error-p (vl-catch-all-apply 'vlax-put-property (list obj 'Color 230) ) ) (princ "Couldn't change color to 230.") (princ "The color has been changed to 230.") ) ) (if (/= currentColor 136) ;; If it's not 136, change it to 136. (if (vl-catch-all-error-p (vl-catch-all-apply 'vlax-put-property (list obj 'Color 136) ) ) (princ "Couldn't change the color to 136.") (princ "The color has been changed to 136.") ) ) (princ "Editing completed.") ) ) ) (princ "It's not an object TEXT/MTEXT.") ) ;;; ) (setvar "CMDECHO" oldcmdecho) (princ) )
  7. That's fine with me...
  8. I think you need one ENTER to exit from 'textedit' and another one to exit from the while loop. I think It’s not possible to solve everything with a right click. The only option that comes close to what you’re asking for is to remove the while loop, so that the command ends after editing each text. But this will force you to press right click to repeat the command. The only option that would allow what you’re describing is to edit the text content with getstring instead of textedit. But I don’t know if you’re willing to do that.
  9. Thanks Saxlle. Works fine
  10. @mhy3sx Try the following code (it work the same as yours, but you can see the part of code for "letter" roration for your part of code, you can get a text angle when creating an arrow): (prompt "\nTo run a LISP type: SECLINE") (princ) (defun c:SECLINE ( / old_osmode flag alphabet dist arrow_base arrow_height text_height spt ept output base_pt ang off_pt arrow_ang arrow_fpt arrow_spt arrow_midpt arrow_tpt letter_ang letter_inspt answ) (setq old_osmode (getvar 'osmode)) (setvar 'osmode 0) (setq flag T alphabet (list "A B C D E F G H I J K L M N O P Q R S T U V W X Y Z") ;; Alphabet UPPERCASE letters dist 0.11 ;; offset distance from section line arrow_base 0.69 arrow_height 0.27 text_height 0.27 ) (if (not (tblsearch "layer" "Section")) (command-s "_layer" "_m" "Section" "_c" "10" "" "_lw" "0.05" "" "") (setvar 'clayer "Section") ) (while (= flag T) (setq spt (getpoint "\nPick the first point:") ept (getpoint spt "\nPick the second point:") ) (command-s "_UNDO" "begin") (entmake (list (cons 0 "LINE") (cons 100 "AcDbEntity") (cons 100 "AcDbLine") (cons 8 (getvar 'clayer)) (cons 10 spt) (cons 11 ept))) (initget 1 (car alphabet)) (setq output (getkword (strcat "\nChoose a letter from the list [" (vl-string-translate " " "/" (car alphabet)) "]: "))) (setq base_pt ept ang (angle spt ept) off_pt (getpoint base_pt "\nPick the side to get an arrow and letter") arrow_ang (angle base_pt off_pt) ) ;; 1. arrow and text (setq arrow_fpt (polar base_pt arrow_ang dist) arrow_spt (polar arrow_fpt ang (- arrow_base)) arrow_midpt (mapcar '* (mapcar '+ arrow_fpt arrow_spt) (list 0.50 0.50)) arrow_tpt (polar arrow_midpt arrow_ang arrow_height) letter_ang (angle arrow_fpt base_pt) letter_inspt (polar arrow_midpt letter_ang (* arrow_height 1.15)) letter_ang (+ pi (/ pi 2) arrow_ang) ) (entmake (list (cons 0 "SOLID") (cons 100 "AcDbEntity") (cons 100 "AcDbTrace") (cons 10 arrow_fpt) (cons 11 arrow_spt) (cons 8 (getvar 'clayer)) (cons 12 arrow_tpt) (cons 13 arrow_tpt))) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 10 letter_inspt) (cons 8 (getvar 'clayer)) (cons 40 text_height) (cons 1 output) (cons 50 letter_ang) (cons 72 1) (cons 73 2) (cons 11 letter_inspt))) ;; 2. arrow and text (setq base_pt spt ang (angle ept spt) arrow_fpt (polar base_pt arrow_ang dist) arrow_spt (polar arrow_fpt ang (- arrow_base)) arrow_midpt (mapcar '* (mapcar '+ arrow_fpt arrow_spt) (list 0.50 0.50)) arrow_tpt (polar arrow_midpt arrow_ang arrow_height) letter_ang (angle arrow_fpt base_pt) letter_inspt (polar arrow_midpt letter_ang (* arrow_height 1.15)) letter_ang (+ pi (/ pi 2) arrow_ang) ) (entmake (list (cons 0 "SOLID") (cons 100 "AcDbEntity") (cons 100 "AcDbTrace") (cons 10 arrow_fpt) (cons 11 arrow_spt) (cons 8 (getvar 'clayer)) (cons 12 arrow_tpt) (cons 13 arrow_tpt))) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 10 letter_inspt) (cons 8 (getvar 'clayer)) (cons 40 text_height) (cons 1 output) (cons 50 letter_ang) (cons 72 1) (cons 73 2) (cons 11 letter_inspt))) (command-s "_UNDO" "end") (initget 1 "Yes No Undo") (setq answ (getkword "\nDo you want to continue or Undo? [Yes/No/Undo]")) (cond ((= answ "No") (setq flag nil) ) ((= answ "Undo") (command-s "_UNDO" "") ) ) (princ) ) (setvar 'osmode old_osmode) (prompt "\nDrawing section lines are done!") (princ) ) This is the short video example. SectionLine.mp4 Best regards.
  11. Yesterday
  12. BIGAL

    Block insert LISP

    For a client did draw arrows I used a entmake pline so have control over the arrow sizes length and width. Its a case of setting the start as 0.0 and a length and an end arrow width. Yes matching angle of a pline and same layer. Can you provide more information about how the arrows are to be shown at each vertice, length and width plus direction.
  13. @mhy3sx Does parametrics exist in ZWCAD ? If so what happens if you edit the example I posted just use Bedit and remove the circles and add your section mark details and save block edits. There should be a stretch option for parametrics. These are blocks and matching code just does a mirror. Just an example of choose type of mark using a pop menu.
  14. Why not check the color 1st change the color then edit it ? Also you can shorten the get put property. Must be a vl object. (setq colorobj (vlax-get obj 'color)) (vlax-put obj 'color 230) Maybe this also ;; If it's 136, change it to 230. (if (= currentColor 136) (vlax-put obj 'color 230) (vlax-put obj 'color 130) ) To select only *text you can use a ssget (while (setq ss (ssget '(( 0 . "*TEXT")))) (setq e (ssname ss 0)) (setq obj (vlax-ename->vla-object e)) Have a look at Lee-mac SSGET functions look at the E: option.
  15. GLAVCVS

    Block insert LISP

    Maybe it's just that property doesn't exist on the specified object.
  16. mhy3sx

    Block insert LISP

    Did you try this ? https://www.cadtutor.net/forum/topic/76319-add-block-onto-polyline-vertices/
  17. Now the arrows is correct. The only problem is the angle of the text is not in all direction in correct angle !!! I want the text to have the same directions with the arrows (defun C:SECTIONLINE ( / pt1 pt2 dirpt secLet baseAngle dx dy cross normalAngle arrowBase arrowHeight arrowOffset offset letterOffset arrow1Base arrow2Base center1 center2 txtpt1 txtpt2 angleGrad) (setq arrowBase 0.69) (setq arrowHeight 0.27) (setq arrowOffset 0.345) (setq offset 0.11) (setq letterOffset 0.42) (command "._STYLE" "Section" "Arial" 0.0 1.4 0 "N" "N" "N") (if (not (tblsearch "layer" "Section")) (command "_-layer" "make" "Section" "color" "10" "" "lw" "0.05" "" "") ) (setvar "clayer" "Section") (setq pt1 (getpoint "\nSelect first point of section line: ")) (if (not pt1) (progn (princ "\nCanceled.") (exit))) (setq pt2 (getpoint pt1 "\nSelect second point of section line: ")) (if (not pt2) (progn (princ "\nCanceled.") (exit))) (setq dirpt (getpoint "\nPick a point to define section direction: ")) (if (not dirpt) (progn (princ "\nCanceled.") (exit))) (setq secLet (getstring T "\nEnter section letter (e.g., A, B): ")) (if (= secLet "") (setq secLet "A")) (setq baseAngle (angle pt1 pt2)) (setq dx (- (car pt2) (car pt1))) (setq dy (- (cadr pt2) (cadr pt1))) (setq cross (- (* dx (- (cadr dirpt) (cadr pt1))) (* dy (- (car dirpt) (car pt1))))) (setq normalAngle (if (> cross 0) (+ baseAngle (/ pi 2)) (- baseAngle (/ pi 2)) )) (command "._LINE" "_non" pt1 "_non" pt2 "") (defun drawArrow (basePoint / center p1 p2 tip) (setq center (polar basePoint normalAngle offset)) (setq p1 (polar center (+ baseAngle pi) (/ arrowBase 2.0))) (setq p2 (polar center baseAngle (/ arrowBase 2.0))) (setq tip (polar center normalAngle arrowHeight)) (command "._PLINE" "_non" p1 "_non" tip "_non" p2 "_non" p1 "") (command "._HATCH" "SOLID" "_L" "" "") center ) (setq arrow1Base (polar pt1 baseAngle arrowOffset)) (setq center1 (drawArrow arrow1Base)) (setq arrow2Base (polar pt2 (+ baseAngle pi) arrowOffset)) (setq center2 (drawArrow arrow2Base)) (defun fix-angle (a) (setq grad (* 200.0 (/ a pi))) (if (or (> grad 100) (< grad -100)) (+ a pi) a ) ) (setq txtAngle1 (fix-angle (+ normalAngle pi))) (setq angleGrad1 (* 200.0 (/ txtAngle1 pi))) (setq txtpt1 (polar center1 (+ normalAngle pi) letterOffset)) (setq txtpt2 (polar center2 (+ normalAngle pi) letterOffset)) (command "._TEXT" "J" "MC" "_non" txtpt1 0.27 angleGrad1 secLet) (command "._TEXT" "J" "MC" "_non" txtpt2 0.27 angleGrad1 secLet) (princ "\nSection line created successfully.") (princ) ) Thanks
  18. Hi BIGAL , PARAMETRICSTRETCH not exist in ZWCAD Thanks
  19. I need to edit the text and change the color.
  20. Hello, With the help of AI I am trying to make a .lsp script that insert specific block on every vertex of a polyline and orient two "arrows" to the previous and next vertex. I try with different AI models and always I end up with error in Autocad (I use Autocad 2022) Error: "ActiveX Server returned the error: unknown name: "DYNAMICBLOCKPROPERTIES". AI say that the block is not really a dynamic block, which I dont get, how block can be not really dynamic. I am attaching both block and .lsp script. I hope someone will give me some advice what is wrong with the block or with .lsp script. BlockInsert.lsp block.dwg
  21. Do you only need to change the color or also edit the text?
  22. Good day everyone! After editing the text, its color changes, but to exit the command, you need to press RMB or enter or Esc twice. Is it possible to complete the execution of the command with the right mouse button in one click? ;; If the current color is not equal to 136, then change it to 136. ;; If the current color is 136, then change it to 230. (defun c:TEcolor136_230 (/ error oldcmdecho sel e type obj res currentColor) (vl-load-com) (defun error (msg) (if oldcmdecho (setvar "CMDECHO" oldcmdecho)) (if (and msg (not (wcmatch (strcase msg) "BREAK,CANCEL,EXIT"))) (princ (strcat " Error: " msg)) ) (princ) ) (setq oldcmdecho (getvar "CMDECHO")) (setvar "CMDECHO" 0) (while (setq sel (entsel " Select TEXT/MTEXT to edit (Enter — exit): ")) (setq e (car sel) type (strcase (cdr (assoc 0 (entget e)))) ) (if (wcmatch type "TEXT,MTEXT") (progn (setq obj (vlax-ename->vla-object e)) ;; get the current color (setq currentColor (vl-catch-all-apply 'vlax-get-property (list obj 'Color)) ) ;; Error handling on receipt (if (vl-catch-all-error-p currentColor) (setq currentColor 0) ) ;; Opening the text editor (setq res (vl-catch-all-apply 'vl-cmdf (list "_.textedit" e)) ) (if (vl-catch-all-error-p res) (princ " Editing canceled.") ;; After editing, we change the color (progn (if (= currentColor 136) ;; If it's 136, change it to 230. (if (vl-catch-all-error-p (vl-catch-all-apply 'vlax-put-property (list obj 'Color 230)) ) (princ " Couldn't change color to 230.") (princ " The color has been changed to 230.") ) ) (if (/= currentColor 136) ;; If it's not 136, change it to 136. (if (vl-catch-all-error-p (vl-catch-all-apply 'vlax-put-property (list obj 'Color 136)) ) (princ " Couldn't change the color to 136.") (princ " The color has been changed to 136.") ) ) (princ " Editing completed.") ) ) ) (princ " It's not an object TEXT/MTEXT.") ) ) (setvar "CMDECHO" oldcmdecho) (princ) )
  23. There is parametrics in Bricscad, similar to dynamic block in Acad. Here is a sample think of the two circles as the section arrow details. Can add attributes etc. I just made a block with gap set to 100, then did Bedit and typed PARAMETRICSTRETCH, follow prompts just select one side. Can add a lisp pick 2 points for alignment and reset length. section.dwg
  24. Last week
  25. BIGAL

    tables

    Another ; make table example ; By Alan H 2018 ; updated for post https://www.cadtutor.net/forum/topic/98664-tables/ Aug 2025 (defun c:maketableXY (/ colwidth numcolumns numrows objtable rowheight sp vgad vgao vgms) (vl-load-com) (setvar "osmode" 0) (setq bm (ssget '((0 . "LINE")))) (if bm (progn (setq num (sslength bm)) (setq i 0) (setq point_list '()) (repeat num (setq obj (ssname bm i)) ; Get entity name (setq db (entget obj)) ; Get entity data (setq p1 (cdr (assoc 10 db))) ; Start point (setq p2 (cdr (assoc 11 db))) ; End point (setq midpt (mapcar '/ (mapcar '+ p1 p2) '(2 2 2))) (setq point_list (cons (list p1 p2 midpt) point_list)) (setq i (1+ i)) ) ) ) (setq sp (vlax-3d-point (getpoint "pick a point for table"))) (Setq vgms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (setq numrows (+ (length point_list))) (setq numcolumns 4) (setq rowheight 9) (setq colwidth 70) (setq objtable (vla-addtable vgms sp numrows numcolumns rowheight colwidth)) (vla-settext objtable 0 0 "Line details") (vla-settext objtable 1 0 "Sr No.") (vla-settext objtable 1 1 "Start point") (vla-settext objtable 1 2 "End point") (vla-settext objtable 1 3 "Mid point") (vla-setcolumnwidth objtable 0 21) (vla-setalignment objTable acTitleRow acMiddleCenter) (vla-setalignment objTable acHeaderRow acMiddleCenter) (vla-setalignment objTable acDataRow acMiddleCenter) (vla-setrowheight objTable acDataRow 9.0) (setq row 2 x 1) (foreach val point_list (vla-settext objtable row 0 (rtos x 2 0)) (setq val1 (strcat (rtos (car (nth 0 val)) 2 3) "," (rtos (cadr (nth 0 val)) 2 3))) (vla-settext objtable row 1 val1) (setq val2 (strcat (rtos (car (nth 1 val)) 2 3) "," (rtos (cadr (nth 1 val)) 2 3))) (vla-settext objtable row 2 val2) (setq val3 (strcat (rtos (car (nth 2 val)) 2 3) "," (rtos (cadr (nth 2 val)) 2 3))) (vla-settext objtable row 3 val3) (setq row (1+ row) x (1+ x)) ) (princ) )
  26. oddssatisfy

    Water fall / stream design

    For designing waterfalls or streams, SketchUp is a very user-friendly option for 3D modeling and conceptual designs. Blender is free and allows realistic 3D water simulations, though it has a steeper learning curve. Realtime Landscaping Architect is also beginner-friendly and specifically tailored for landscaping with waterfalls and streams. For precise 2D layouts, AutoCAD or AutoCAD Civil 3D is a good choice.
  27. see if this drawing is correct. I used project from pyrx import Ap, Ax, Db, Ge # register command @Ap.Command() def doit(): try: db = Db.curDb() ms = db.modelSpace(Db.OpenMode.kForWrite) plane = Ge.Plane(Ge.Point3d.kOrigin,Ge.Vector3d.kZAxis) for id in ms.objectIds(Db.Curve.desc()): dbc = Db.Curve(id) gec = dbc.getAcGeCurve() geproj = gec.project(plane,Ge.Vector3d.kZAxis) if not geproj.isKindOf(Ge.kCurve3d): continue geprojCurve = Ge.Curve3d.cast(geproj) dbproj = Db.Core.convertGelibCurveToAcDbCurve(geprojCurve) ms.appendAcDbEntity(dbproj) dbproj.setColorIndex(1) except Exception as err: print(err) arc2.dwg
  28. Tsuky

    tables

    Perhaps this ? (vl-load-com) (defun c:lines2cell ( / js AcDoc Space nw_style oldim oldlay ins_pt_cell h_t w_c lst_id-seg lst_pt n obj dxf_10 dxf_11 mid_pt nb nw_obj ename_cell n_row n_column) (princ "\nSelect points.") (while (null (setq js (ssget '((0 . "LINE"))))) (princ "\nSelection empty, or is not a lines!") ) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (cond ((null (tblsearch "LAYER" "Table-Lines")) (vla-add (vla-get-layers AcDoc) "Table-Lines") ) ) (cond ((null (tblsearch "STYLE" "Text-Cell")) (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Text-Cell")) (mapcar '(lambda (pr val) (vlax-put nw_style pr val) ) (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag) (list (strcat (getenv "windir") "\\fonts\\arial.ttf") 0.0 (/ (* 15.0 pi) 180) 1.0 0.0) ) (command "_.ddunits" (while (not (zerop (getvar "cmdactive"))) (command pause) ) ) ) ) (setq oldim (getvar "dimzin") oldlay (getvar "clayer") ) (setvar "dimzin" 0) (setvar "clayer" "Table-Lines") (initget 9) (setq ins_pt_cell (getpoint "\nLeft-Up insert point of table: ")) (initget 6) (setq h_t (getdist ins_pt_cell (strcat "\nHigth text <" (rtos (getvar "textsize")) ">: "))) (if (null h_t) (setq h_t (getvar "textsize")) (setvar "textsize" h_t)) (initget 7) (setq w_c (getdist ins_pt_cell "\nWidth of cells: ")) (setq lst_id-seg '() lst_pt '() nb 0 ) (repeat (setq n (sslength js)) (setq obj (ssname js (setq n (1- n))) dxf_10 (cdr (assoc 10 (entget obj))) dxf_11 (cdr (assoc 11 (entget obj))) mid_pt (mapcar '* (mapcar '+ dxf_10 dxf_11) '(0.5 0.5 0.5)) lst_pt (cons (list dxf_10 dxf_11 mid_pt) lst_pt) nb (1+ nb) lst_id-seg (cons nb lst_id-seg) ) ) (mapcar '(lambda (p tx) (setq nw_obj (vla-addMtext Space (vlax-3d-point p) 0.0 tx ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation) (list 5 h_t 5 p "Text-Cell" "Table-Lines" 0.0) ) ) (mapcar 'caddr lst_pt) lst_id-seg ) (vla-addTable Space (vlax-3d-point ins_pt_cell) (+ 2 nb) 10 (+ h_t (* h_t 0.25)) w_c) (setq ename_cell (vlax-ename->vla-object (entlast)) n_row (1+ nb) n_column -1) (vla-SetCellValue ename_cell 0 0 (vlax-make-variant (strcat "Summary of " (itoa (sslength js)) " LINES") 8 ) ) (vla-SetCellTextStyle ename_cell 0 0 "Text-Cell") (vla-SetCellTextHeight ename_cell 0 0 (vlax-make-variant h_t 5)) (vla-SetCellAlignment ename_cell 0 0 5) (foreach n (mapcar'list (append lst_id-seg '("N°")) (append (mapcar 'rtos (mapcar 'caar lst_pt)) '("Start X")) (append (mapcar 'rtos (mapcar 'cadar lst_pt)) '("Start Y")) (append (mapcar 'rtos (mapcar 'caddar lst_pt)) '("Start Z")) (append (mapcar 'rtos (mapcar 'caadr lst_pt)) '("End X")) (append (mapcar 'rtos (mapcar 'cadadr lst_pt)) '("End Y")) (append (mapcar 'rtos (mapcar 'caddar (mapcar 'cdr lst_pt))) '("End Z")) (append (mapcar 'rtos (mapcar 'caaddr lst_pt)) '("Middle X")) (append (mapcar 'rtos (mapcar 'cadadr (mapcar 'cdr lst_pt))) '("Middle Y")) (append (mapcar 'rtos (mapcar 'caddar (mapcar 'cddr lst_pt))) '("Middle Z")) ) (mapcar '(lambda (el) (vla-SetCellValue ename_cell n_row (setq n_column (1+ n_column)) (vlax-make-variant el 8)) (vla-SetCellTextStyle ename_cell n_row n_column "Text-Cell") (vla-SetCellTextHeight ename_cell n_row n_column (vlax-make-variant h_t 5)) (if (eq n_row 1) (vla-SetCellAlignment ename_cell n_row n_column 5) (vla-SetCellAlignment ename_cell n_row n_column 6) ) ) n ) (setq n_row (1- n_row) n_column -1) ) (setvar "dimzin" oldim) (setvar "clayer" oldlay) (prin1) )
  29. maahee

    tables

    (defun c:ctf (/ bm num i obj db p1 p2 midpt point_list table pt) (setvar "osmode" 0) ; Select all lines (setq bm (ssget '((0 . "LINE")))) (if bm (progn ; Get number of lines (setq num (sslength bm)) (setq i 0) (setq point_list '()) ; Initialize list to store points ; Loop through each line (repeat num (setq obj (ssname bm i)) ; Get entity name (setq db (entget obj)) ; Get entity data (setq p1 (cdr (assoc 10 db))) ; Start point (setq p2 (cdr (assoc 11 db))) ; End point ; Calculate midpoint (setq midpt (mapcar '/ (mapcar '+ p1 p2) '(2 2 2))) ; Store points in list (setq point_list (cons (list p1 p2 midpt) point_list)) (setq i (1+ i)) ) (setq pt (getpoint "\nSpecify table insertion point: ")) (if pt (progn ; Create table (command "._TABLE" 4 3 pt) ; Set header (command "._TABLEdit" "A1" "TEXT" "sr.no") (command "._TABLEdit" "B1" "TEXT" "Start Point") (command "._TABLEdit" "c1" "TEXT" "endPoint") (command "._TABLEdit" "D1" "TEXT" "mid Point") ; extract data of the lines and filling in cells of table ; point_list data stored ;autocad ver 2025 ) (princ "\nNo insertion point specified.") ) ) (princ "\nNo lines selected.") ) (setvar "osmode" 511) (princ) ) I need to help data automatically fill in the cells of the table table.dwg
  1. Load more activity
×
×
  • Create New...