Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 08/22/2023 in all areas

  1. 1 point
  2. @Steven P & @BIGAL WORKS PERFECTLY - MANY THANKS!!! aridzv
    1 point
  3. Spent 10 minutes seeing what I missed - should be this line instead: (LM:vl-setattributevalue bobj "Order" (rtos (nth 2 blk)) )
    1 point
  4. Change this line (setq lst (cons (list ord itm qty) lst)) in terms of the item order. This will fix the data cells, you need to also do the headings. '("ORDER" "QUANTITY" "ITEM_DESCRIPTION") '(ord qty itm) Hopefully works not tested.
    1 point
  5. Hi You can try this for move text to mleader (vl-load-com) (defun make_mlead (pt str lay / tmp ptlst arr nw_obj) (initget 9) (setq tmp (getpoint (trans pt 0 1) "\nLeader position: ") ptlst (append pt (polar pt (angle pt (trans tmp 1 0)) (distance pt (trans tmp 1 0)))) arr (vlax-make-safearray vlax-vbdouble (cons 0 (- (length ptlst) 1))) ) (vlax-safearray-fill arr ptlst) (setq nw_obj (vla-addMLeader Space (vlax-make-variant arr) 0)) (vla-put-contenttype nw_obj acMTextContent) (vla-put-textstring nw_obj str) (vla-put-layer nw_obj lay) (vla-put-ArrowheadSize nw_obj (* (getvar "TEXTSIZE") 0.5)) (vla-put-TextHeight nw_obj (getvar "TEXTSIZE")) (if (> (car pt) (car (trans tmp 1 0))) (progn (vla-SetDogLegDirection nw_obj 0 (vlax-3D-point '(-1.0 0.0 0.0))) (vla-put-TextJustify nw_obj acAttachmentPointMiddleRight) (vla-setLeaderLineVertices nw_obj 0 (vlax-make-variant arr)) ) (vla-put-TextJustify nw_obj acAttachmentPointMiddleLeft) ) (vla-update nw_obj) ) (vl-load-com) (defun c:movetxt2leader ( / js htx AcDoc Space ent pt ss dxf_ent txt lay) (princ "\nSelect polyline.") (while (not (setq js (ssget "_+.:E:S" '((0 . "LWPOLYLINE")))))) (initget 6) (setq htx (getdist (getvar "VIEWCTR") (strcat "\nGive text size <" (rtos (getvar "TEXTSIZE")) ">: "))) (if htx (setvar "TEXTSIZE" htx)) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (vla-startundomark AcDoc) (setq ent (ssname js 0) pr -1) (redraw ent 3) (repeat (fix (vlax-curve-getEndParam ent)) (setq pt (vlax-curve-GetPointAtParam ent (setq pr (1+ pr))) ss (ssget "_C" pt (mapcar '+ pt (list (getvar "PDSIZE") (getvar "PDSIZE") (getvar "PDSIZE"))) '((0 . "TEXT")) ) ) (cond (ss (setq dxf_ent (entget (ssname ss 0)) txt (cdr (assoc 1 dxf_ent)) lay (cdr (assoc 8 dxf_ent)) ) (make_mlead pt txt lay) (entdel (ssname ss 0)) ) ) ) (redraw ent 4) (vla-regen AcDoc acactiveviewport) (vla-endundomark AcDoc) (prin1) )
    1 point
  6. Wasn't going that complicated. using the polyline vertex to pick the closet text to keep in some what of an order. rather then jumping all around. You could use grread to display text as your moving it. This is more a proof of concept. anyone else feel free to make changes. (defun C:TxtMov (/ mspace ss ssP cords size base LL UR pt2) (vl-load-com) (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object)))) (setq mspace (vla-get-ModelSpace doc)) (prompt "\nSelect Polyline to Follow") (setq ssP (ssget "_+.:E:S" '((0 . "LWPOLYLINE")))) (setq cords (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname ssP 0))))) (setq size (getreal "\nText Size: ")) (prompt "\nSelect Text") (while (setq ss (ssget '((0 . "TEXT")))) (foreach pt cords (foreach txt (mapcar 'vlax-Ename->Vla-Object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) (if (and (setq base (vlax-get txt 'InsertionPoint)) (< (distance pt base) 0.05)) (progn (vla-put-height txt size) (command "_.Move" (vlax-vla-object->ename txt) "" "_NONE" pt pause) (vla-getboundingbox txt 'minpt 'maxpt) (setq LL (vlax-safearray->list minpt) UR (vlax-safearray->list maxpt) ) (command "_.Rectangle" "_non" LL "_non" UR) (setq pt2 (vlax-curve-getClosestPointTo (entlast) pt)) (entdel (entlast)) (vla-addline mspace (vlax-3d-point pt) (vlax-3d-point pt2)) ;needed (vlax-3d-point (ssdel (vlax-vla-object->ename txt) ss) ) ) ) ) (prompt "\nSelect Text") ) (vla-endundomark doc) (princ) )
    1 point
×
×
  • Create New...