Leaderboard

Below is a solution defining two commands (LPNT & LVTX) to label an arbitrary number of selected points, or a set of polylines with an arbitrary number of vertices: (defun c:lpnt ( / ocs pnt str ) (setq ocs (trans '(0 0 1) 1 0 t) str "" ) (while (setq pnt (getpoint (strcat "\nSpecify point \"" (setq str (LM:alpha++ str)) "\" <exit>: "))) (entmaketext (trans pnt 1 ocs) str ocs) ) (princ) ) (defun c:lvtx ( / enx idx ocs sel str ) (if (setq sel (ssget '((0 . "LWPOLYLINE")))) (repeat (setq idx (sslength sel)) (setq idx (1- idx) enx (entget (ssname sel idx)) ocs (cdr (assoc 210 enx)) str "" ) (foreach dxf enx (if (= 10 (car dxf)) (entmaketext (cdr dxf) (setq str (LM:alpha++ str)) ocs) ) ) ) ) (princ) ) (defun entmaketext ( ins str ocs ) (entmake (list '(000 . "TEXT") (cons 010 ins) (cons 011 ins) (cons 001 str) (cons 040 (getvar 'textsize)) (cons 007 (getvar 'textstyle)) (cons 050 (angle '(0.0 0.0) (trans (getvar 'ucsxdir) 0 ocs t))) '(072 . 1) '(073 . 2) (cons 210 ocs) ) ) ) ;; Alpha++ - Lee Mac ;; Increments an uppercase alphabetical string by one, e.g. AZ => BA ;; a - [str] uppercase alphabetical string (defun LM:alpha++ ( a / n ) (if (= "" a) "A" (if (= "Z" (substr a (setq n (strlen a)))) (strcat (LM:alpha++ (substr a 1 (1- n))) "A") (strcat (substr a 1 (1- n)) (chr (1+ (ascii (substr a n))))) ) ) ) (princ "\n\"LPNT\" to label points | \"LVTX\" to label vertices") (princ) The commands should also operate successfully under all UCS & View settings.

Hi, Try this. (defun c:Test ( / pnt ltr) (setq ltr 64) (while (setq pnt (getpoint "\nSpecify a point :")) (entmake (list '(0 . "TEXT") (cons 10 (trans pnt 0 1)) (cons 40 (getvar 'TEXTSIZE)) (cons 7 (getvar 'TEXTSTYLE)) (cons 1 (chr (if (= (setq ltr (1+ ltr)) 91) (setq ltr 65) ltr)))) ) ) (princ) )

Try the following code: (defun c:matchblock ( / att blk ent idx lst obj par sel vis ) (while (progn (setvar 'errno 0) (setq ent (car (entsel "\nSelect source block <exit>: "))) (cond ( (= 7 (getvar 'errno)) (princ "\nMissed, try again.") ) ( (null ent) nil) ( (/= "AcDbBlockReference" (vla-get-objectname (setq obj (vlax-ename->vla-object ent)))) (princ "\nThe selected object is not a block.") ) ( (= :vlax-false (vla-get-hasattributes obj) (vla-get-isdynamicblock obj)) (princ "\nThe selected block is neither attributed nor dynamic.") ) ) ) ) (if (and ent (setq sel (LM:ssget "\nSelect target blocks <exit>: " '("_:L" ((0 . "INSERT")))))) (progn (setq obj (vlax-ename->vla-object ent) att (LM:vl-getattributevalues obj) vis (LM:getvisibilitystate obj) ) (repeat (setq idx (sslength sel)) (setq idx (1- idx) obj (vlax-ename->vla-object (ssname sel idx)) ) (if att (LM:vl-setattributevalues obj att)) (if (and vis (= :vlax-true (vla-get-isdynamicblock obj)) (or (setq blk (strcase (LM:effectivename obj)) par (cdr (assoc blk lst)) ) (and (setq par (LM:getvisibilityparametername obj)) (setq lst (cons (cons blk par) lst)) ) ) ) (vl-some '(lambda ( prp ) (if (and (= par (vla-get-propertyname prp)) (member vis (vlax-get prp 'allowedvalues)) ) (vla-put-value prp (vlax-make-variant vis (vlax-variant-type (vla-get-value prp)))) ) ) (vlax-invoke obj 'getdynamicblockproperties) ) ) ) ) ) (princ) ) ;; Effective Block Name - Lee Mac ;; obj - [vla] VLA Block Reference object (defun LM:effectivename ( obj ) (vlax-get-property obj (if (vlax-property-available-p obj 'effectivename) 'effectivename 'name ) ) ) ;; Get Attribute Values - Lee Mac ;; Returns an association list of attributes present in the supplied block. ;; blk - [vla] VLA Block Reference Object ;; Returns: [lst] Association list of ((<tag> . <value>) ... ) (defun LM:vl-getattributevalues ( blk ) (mapcar '(lambda ( att ) (cons (vla-get-tagstring att) (vla-get-textstring att))) (vlax-invoke blk 'getattributes)) ) ;; Set Attribute Values - Lee Mac ;; Sets attributes with tags found in the association list to their associated values. ;; blk - [vla] VLA Block Reference Object ;; lst - [lst] Association list of ((<tag> . <value>) ... ) ;; Returns: nil (defun LM:vl-setattributevalues ( blk lst / itm ) (foreach att (vlax-invoke blk 'getattributes) (if (setq itm (assoc (vla-get-tagstring att) lst)) (vla-put-textstring att (cdr itm)) ) ) ) ;; Get Dynamic Block Visibility State - Lee Mac ;; Returns the value of the Visibility Parameter of a Dynamic Block (if present) ;; blk - [vla] VLA Dynamic Block Reference object ;; Returns: [str] Value of Visibility Parameter, else nil (defun LM:getvisibilitystate ( blk / vis ) (if (setq vis (LM:getvisibilityparametername blk)) (LM:getdynpropvalue blk vis) ) ) ;; Get Dynamic Block Property Value - Lee Mac ;; Returns the value of a Dynamic Block property (if present) ;; blk - [vla] VLA Dynamic Block Reference object ;; prp - [str] Dynamic Block property name (case-insensitive) (defun LM:getdynpropvalue ( blk prp ) (setq prp (strcase prp)) (vl-some '(lambda ( x ) (if (= prp (strcase (vla-get-propertyname x))) (vlax-get x 'value))) (vlax-invoke blk 'getdynamicblockproperties) ) ) ;; Get Visibility Parameter Name - Lee Mac ;; Returns the name of the Visibility Parameter of a Dynamic Block (if present) ;; blk - [vla] VLA Dynamic Block Reference object ;; Returns: [str] Name of Visibility Parameter, else nil (defun LM:getvisibilityparametername ( blk / vis ) (if (and (vlax-property-available-p blk 'effectivename) (setq blk (vla-item (vla-get-blocks (vla-get-document blk)) (vla-get-effectivename blk) ) ) (= :vlax-true (vla-get-isdynamicblock blk)) (= :vlax-true (vla-get-hasextensiondictionary blk)) (setq vis (vl-some '(lambda ( pair ) (if (and (= 360 (car pair)) (= "BLOCKVISIBILITYPARAMETER" (cdr (assoc 0 (entget (cdr pair))))) ) (cdr pair) ) ) (dictsearch (vlax-vla-object->ename (vla-getextensiondictionary blk)) "ACAD_ENHANCEDBLOCK" ) ) ) ) (cdr (assoc 301 (entget vis))) ) ) ;; ssget - Lee Mac ;; A wrapper for the ssget function to permit the use of a custom selection prompt ;; msg - [str] selection prompt ;; arg - [lst] list of ssget arguments (defun LM:ssget ( msg arg / sel ) (princ msg) (setvar 'nomutt 1) (setq sel (vl-catch-all-apply 'ssget arg)) (setvar 'nomutt 0) (if (not (vl-catch-all-error-p sel)) sel) ) (vl-load-com) (princ)

Tested and revised. (defun c:LPV ( / t_lst ent last_v e_pt s_pt cnt ) (setq t_lst (list "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "M" "N")) (cond ( (and (setq ent (car (entsel "\nSelect Polyline to Label : "))) (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE") ) (setq last_v (vlax-curve-getendparam ent) e_pt (vlax-curve-getendpoint ent) s_pt (vlax-curve-getstartpoint ent) cnt 0.0 ) (if (equal e_pt s_pt 0.001) (setq last_v (1- last_v))) (while (<= cnt last_v) (entmakex (list (cons 0 "TEXT") (cons 7 (getvar 'textstyle)) (cons 40 (getvar 'textsize)) (cons 10 (vlax-curve-getpointatparam ent cnt)) (cons 1 (nth (fix cnt) t_lst)) ) ) (setq cnt (1+ cnt)) ) ) ) (princ) ) (princ)

Try this, down and dirty and NOT tested as I have No access to AutoCAD at the moment. (defun c:LPV ( / t_lst ent last_v cnt ) (setq t_lst (list "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "M" "N")) (cond ( (and (setq ent (car (entsel "\nSelect Polyline to Label : "))) (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE") ) (setq last_v (vlax-curve-getendparam ent) cnt 0.0 ) (while (<= cnt last_v) (entmakex (list (cons 0 "TEXT") (cons 7 (getvar 'textstyle)) (cons 40 (getvar 'textsize)) (cons 10 (vlax-curve-getpointatparam ent cnt)) (cons 1 (nth (fix cnt) t_lst)) ) ) (setq cnt (1+ cnt)) ) ) ) (princ) ) (princ)

Can you attach a copy of the original drawing to your next post so we can attempt to duplicate the problem? AEC objects present?

Yes, I know where they are. There are over 4,000 instances altogether, which means it's only feasible if it can be done using a bot or macro. I'm guessing that it could be done using a regex on the MySQL file and I will try to test this out on a non-live file to see if it works. But, in the meantime, I'm happy to make corrections on an ad hoc basis so that we pick up and correct the most obvious or most visited examples first.