Leaderboard
Popular Content
Showing content with the highest reputation on 12/14/2024 in all areas
-
Just because it stands out as one of the first lines in copy-entity (entmakex entdata) ;; Return the newly created entity name (entlast) You don't need the last (entlast), entmakex returns the entity name1 point
-
code updated, much faster (29objects in 1.3sec) (defun copy-entity (entity) ;; Get all DXF codes for the entity (setq entdata (entget entity)) ;; Create a new entity with the same DXF codes (entmakex entdata) ;; Return the newly created entity name (entlast)) (defun c:txt2mtxZW (/ ss ssFiltered ent entdata txt_height txt_widthfactor txt_obliqueangle txt_style style_obj style_data font_name entlast_set i text1 text1cont first_char mtext1 mtext1cont dummy_txt1 dummy_mtxt1 dummy_txt1_vert1 dummy_mtxt1_vert1 diffX diffY insert_point elast elast1 new new1) ;; Ask to select TEXT objects (setq ss (ssget '((0 . "TEXT")))) (princ (strcat "\nNumber of TEXT objects selected: " (itoa (sslength ss)))) ;; For the first selected object, read its properties (if ss (progn (setq ent (ssname ss 0)) (setq entdata (entget ent)) ;; Get text height (setq txt_height (cdr (assoc 40 entdata))) (princ (strcat "\nText Height: " (rtos txt_height 2 2))) ;; Get text width factor (setq txt_widthfactor (cdr (assoc 41 entdata))) (princ (strcat "\nText Width Factor: " (rtos txt_widthfactor 2 2))) ;; Get text oblique angle (setq txt_obliqueangle (cdr (assoc 51 entdata))) (princ (strcat "\nText Oblique Angle: " (rtos txt_obliqueangle 2 2))) ;; Get text style (setq txt_style (cdr (assoc 7 entdata))) (princ (strcat "\nText Style: " txt_style)) ;; Get font name from text style (setq style_obj (tblobjname "style" txt_style)) (setq style_data (entget style_obj)) (setq font_name (cdr (assoc 3 style_data))) (princ (strcat "\nFont Name: " font_name)) ;; Create the new text style Standard_parcels (entmakex (list '(0 . "STYLE") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbTextStyleTableRecord") ; Subclass marker (AcDbTextStyleTableRecord) (cons 2 "Standard_parcels") ; Style name '(70 . 0) ; Standard flag values (bit-coded values): (cons 40 0.0) ; Fixed text height; 0 if not fixed (cons 41 txt_widthfactor) ; Width factor (cons 50 txt_obliqueangle) ; Oblique angle '(71 . 0) ; Text generation flags: '(42 . 0.0) ; Last height used (cons 3 font_name) ; Primary font file name '(4 . "") ; Bigfont file name; blank if none ) ) (princ "\nText style Standard_parcels created.") ;; Set Standard_parcels as the current text style (setvar "TEXTSTYLE" "Standard_parcels") (princ "\nText style Standard_parcels has been set as current.") ;; Create the selection set for TEXT objects (setq ss (ssget '((0 . "TEXT")))) (princ (strcat "\nNumber of TEXT objects in selection set: " (itoa (sslength ss)))) (setq entlast_set (ssadd)) (start-timer) ;; Iterate through each selected TEXT entity (setq i 0) (while (< i (sslength ss)) (setq text1 (ssname ss i)) ;; Read the text content from text1 (setq text1cont (cdr (assoc 1 (entget text1)))) ;(setq first_char (substr text1cont 1 1)) (setq first_char text1cont) ;; Copy text1 using the new function (setq text1_copy (copy-entity text1)) ;; Convert TEXT to MTEXT (command "_txt2mtxt" text1 "") ;; Assign the last created entity to mtext1 (setq mtext1 (entlast)) ;; Read the text content from mtext1 (setq mtext1cont (cdr (assoc 1 (entget mtext1)))) ;; Change the text style of mtext1 to Standard_parcels (entmod (subst (cons 7 "Standard_parcels") (assoc 7 (entget mtext1)) (entget mtext1))) ;; Read the insertion point from mtext1 (setq insert_point (cdr (assoc 10 (entget mtext1)))) ;; Change the text content to first_char in text1_copy and mtext1 (entmod (subst (cons 1 first_char) (assoc 1 (entget text1_copy)) (entget text1_copy))) (entmod (subst (cons 1 first_char) (assoc 1 (entget mtext1)) (entget mtext1))) ;; Copy text1_copy to a new location before exploding (setq text1_copy_explode (copy-entity text1_copy)) ; (setq text1_copy_explode (copy-entity text1_copy)) ;; Use the _txtexp command on text1_copy_explode (setq elast (entlast)) ; mark last-drawn entity before copying (setq new (ssadd)) ; start empty selection set (command "_txtexp" text1_copy_explode "") ;; Create selection set (while (setq elast (entnext elast)) (setq new (ssadd elast new))) ;; Assign the created entity to dummy_txt1 (setq dummy_txt1 (entlast)) ;; Read the first vertex from dummy_txt1 (setq dummy_txt1_vert1 (vlax-curve-getPointAtDist dummy_txt1 0.0)) ;; Copy mtext1 to a new location before exploding (setq mtext1_copy_explode (copy-entity mtext1)) ; (setq mtext1_copy_explode (copy-entity mtext1)) ;; Use the _txtexp command on mtext1_copy_explode (setq elast1 (entlast)) ; mark last-drawn entity before copying (setq new1 (ssadd)) ; start empty selection set (command "_txtexp" mtext1_copy_explode "") ;; Create selection set (while (setq elast1 (entnext elast1)) (setq new1 (ssadd elast1 new1))) ;; Assign the created entity to dummy_mtxt1 (setq dummy_mtxt1 (entlast)) ;; Read the first vertex from dummy_mtxt1 (setq dummy_mtxt1_vert1 (vlax-curve-getPointAtDist dummy_mtxt1 0.0)) ;; Calculate the differences in X and Y coordinates (setq diffX (- (car dummy_mtxt1_vert1) (car dummy_txt1_vert1))) (setq diffY (- (cadr dummy_mtxt1_vert1) (cadr dummy_txt1_vert1))) (princ "\n") (princ diffY) (princ "\n") ;; Change the insertion point coordinates in mtext1 (entmod (subst (cons 10 (list (- (car insert_point) diffX) (- (cadr insert_point) diffY) 0.0)) (assoc 10 (entget mtext1)) (entget mtext1))) ;(entmod (subst (cons 10 (list (- (car insert_point) diffX) ((cadr insert_point) 0.0) (assoc 10 (entget mtext1)) (entget mtext1))) ;; Restore the text content in text1_copy and mtext1 (entmod (subst (cons 1 text1cont) (assoc 1 (entget text1_copy)) (entget text1_copy))) (entmod (subst (cons 1 mtext1cont) (assoc 1 (entget mtext1)) (entget mtext1))) ;; Assign text1_copy back to text1 (setq text1 text1_copy) ;; Delete dummy_txt1 and dummy_mtxt1 entities (entdel dummy_txt1) (entdel dummy_mtxt1) (command "_erase" new "") (command "_erase" new1 "") ;; Add mtext1 to entlast_set (setq entlast_set (ssadd mtext1 entlast_set)) (setq i (1+ i)) ) (princ (strcat "\nNumber of MTEXT entities created: " (itoa (sslength entlast_set)))) (stop-timer) ) ) (princ) ) (defun start-timer () "Start the timer and store the start time." (setq start-time (getvar "DATE"))) (defun stop-timer () "Stop the timer, calculate the elapsed time, and display it." (setq end-time (getvar "DATE")) ;; Calculate the elapsed time in seconds (setq elapsed-time (* (- end-time start-time) 86400.0)) ;; Display the elapsed time (princ (strcat "\nElapsed Time: " (rtos elapsed-time 2 2) " seconds")) (princ)) (defun copy-entity (entity) ;; Get all DXF codes for the entity (setq entdata (entget entity)) ;; Create a new entity with the same DXF codes (entmakex entdata) ;; Return the newly created entity name (entlast))1 point
-
1 point
-
Using VLAX can save a couple of lines when getting pline points. (setq r (vlax-get ob 'coordinates)) I tend to use this, I think it was a suggestion by Lee-Mac. (setq plent (entsel "\nPick rectang")) (if plent (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent))))))1 point
-
@Akanezuko If I'm interpreting you correctly - try this: (defun c:SelinPoly (/ es ob pts r ss) (if (and (setq es (entsel "\nSelect a polygon: ")) (= (cdr (assoc 0 (entget (car es)))) "LWPOLYLINE") ) (progn (setq ob (vlax-ename->vla-object (car es)) pts (vla-get-coordinates ob) pts (vlax-safearray->list (vlax-variant-value pts)) ) (while pts (setq r (cons (list (car pts) (cadr pts)) r) pts (cddr pts) ) ) (if (> (length r) 2) (progn (entdel (car es)) (setq ss (ssget "CP" r '((0 . "*POLYLINE")))) (entdel (car es)) (sssetfirst nil ss) ) (princ "\nSelected Polygon must be more than 2 points.") ) ) (princ "\nYou must select a Polygon.") ) (princ) )1 point
-
I have moved your thread to the AutoLISP, Visual LISP & DCL Forum. Please post in the correct forum.1 point
-
"AutoCAD objects like dimensions are affected by the drawing scale." if you make the objects annotative it should fix that problem. I have sent you a link for the video.1 point