Jump to content

Leaderboard

Popular Content

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

  1. (defun c:buildingelev ( / *error* pt ex:lwpline_by_list pt elev pt1 clr arrow1 arrow2 arrow3 arrow4 arrow5 arrow6 arrow7 arrow8 arrowPoints oldLayer layerName lay lwp textStr textPtLeft textsize textent) (vl-load-com) (defun *error* (msg) (if (/= msg "Function cancelled") (princ (strcat "\nError: " msg)) ) (setvar "CLAYER" oldLayer) (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) (princ) ) ; make lwpolyline by pointlist ; lst - point list (2d), cls - closed (0 - no, 1 - yes), clr - color (by aci, 256 - by layer, 0 - by block, 1 - red, 2 - yellow ~~ ) ; return - ename (defun ex:lwpline_by_list (lst cls clr) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 62 clr) (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) lst) ) ) ) (vla-startundomark (vla-get-activedocument (vlax-get-acad-object))) (setq oldLayer (getvar "CLAYER")) (setq layerName "LEVEL_NCW") (if (not (tblsearch "LAYER" layerName)) (progn (setq lay (vla-add (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object))) layerName)) (vlax-put-property lay 'color clr) ) ) (setvar "CLAYER" layerName) (while (setq pt (getpoint "\nSelecione o ponto: (pick point - continue / space bar or esc - exit)")) (setq elev (cadr pt)) (setq pt1 (trans pt 0 1 elev)) (setq clr 2) ;temp value - yellow ;; Arrow Creation (setq arrow1 (list (- (car pt1) 0.000) (+ (cadr pt1) 0.0))) ; Position for arrow1 (setq arrow2 (list (- (car pt1) 0.075) (+ (cadr pt1) 0.175))) ; Position for arrow2 (setq arrow3 (list (- (car pt1) 0.019) (+ (cadr pt1) 0.150))) ; Position for arrow3 (setq arrow4 (list (- (car pt1) 0.038) (+ (cadr pt1) 0.235))) ; Position for arrow4 (setq arrow5 (list (+ (car pt1) 0.038) (+ (cadr pt1) 0.235))) ; Position for arrow5 (setq arrow6 (list (+ (car pt1) 0.019) (+ (cadr pt1) 0.150))) ; Position for arrow6 (setq arrow7 (list (+ (car pt1) 0.075) (+ (cadr pt1) 0.175))) ; Position for arrow7 (setq arrow8 (list (+ (car pt1) 0.000) (+ (cadr pt1) 0.000))) ; Position for arrow8 (setq arrowPoints (list arrow1 arrow2 arrow3 arrow4 arrow5 arrow6 arrow7 arrow8)) (setq lwp (ex:lwpline_by_list arrowPoints 0 256)) ;; Criação do texto (setq textStr (rtos elev 2 2)) ; Converte a elevação para string (setq textPtLeft (trans (list (- (car pt) 0.0) (+ (cadr pt) 0.3)) 0 0 elev)) ; Posicionamento do texto à esquerda (setq textsize 0.3) ;temp value, or (setq textsize (getvar 'textsize)) (setq textent (entmakex (list (cons 0 "TEXT") (cons 62 256) (cons 10 textPtLeft) (cons 40 textsize) (cons 1 textStr) (cons 50 0) (cons 41 1) (cons 51 0) (cons 71 0) (cons 72 0) (cons 73 0) ) ) ) ) (setvar "CLAYER" oldLayer) (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) (princ) ) i cannot load your image, but if below gif is what you want, try this
    3 points
  2. Ah, if you want the Attribute called ITEM_DESCRIPTION, you can use: ;********************************************************; ;; Get Attribute Value - Lee Mac ;; Returns the value held by the specified tag within the supplied block, if present. ;; blk - [ent] Block (Insert) Entity Name ;; tag - [str] Attribute TagString ;; Returns: [str] Attribute value, else nil if tag is not found. (defun LM:getattributevalue (blk tag / val enx) (while (and (null val) (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))) ) (if (= (strcase tag) (strcase (cdr (assoc 2 enx)))) (setq val (cdr (assoc 1 (reverse enx)))) ) ) ) It would be called by using: (setq bname (LM:getattributevalue (ssname ss x) "ITEM_DESCRIPTION")) But in this case for the *U21 block, I'll just rename that block to the proper name which is the ITEM_DESCRIPTION attribute or filter unnamed *U blocks to give the attribute value instead. I would use something like this: (if (vl-string-search "*U" bname) (setq bname (LM:getattributevalue (ssname ss x) "ITEM_DESCRIPTION")) (setq bname bname) ) Also, whenever you print the names, I would get an endline delimiter to see all the names properly or delimit with a spacebar even or commas. For me though, I would probably design an ssget filter that takes a list of names of blocks to get all that I need but that's a bit overkill but I already have that somewhere.
    1 point
  3. I was more or less looking to get the OP to work it out a little more. I can post my tutorial later, maybe tomorrow as there are already solutions posted.
    1 point
  4. Yes, thanks @hosneyalaa TextJustify was the one. (vl-load-com) ;; ---------------------=={ MLEADER_Recreate }==-------------------------- ;; ----------------------------------------------------------------------- ;; AUTHOR & ADDITIONAL CODE ;; Author: by 3dwannab, Copyright © 2023 ;; ABOUT / NOTES ;; - Recreates MULTILEADER/s with 2 or 3 points ;; - This solves the issues with MLEADER styles been overridden in the properties dialog ;; FUNCTION SYNTAX ;; Short-cut MR ;; Long-cut MLEADER_Recreate ;; VERSION DATE INFO ;; Version 1.0 2018.08.26 1st draft 2018.07.26 ;; Version 1.1 2019.03.18 Added ScaleFactor & TextFrameDisplay to newly created MLs' ;; Version 1.2 2023.08.02 Added TextBackGroundFill to newly created MLs' if it exists on old MLs ;; Version 1.3 2023.08.24 Added TextJustify to newly created MLs' ;; TO DO LIST ;; - To update with mleader_vlML.lsp in my Help folder ;; ----------------------------------------------------------------------- ;; ------------------=={ MLEADER_Recreate START }==----------------------- (setq *MLEADER_Recreate-Ver* "1.2") (defun c:MLEADER_Recreate nil (c:MR)) (defun c:MR (/ acDoc *error* cnt en endata getLay getTxtJustify getTxtBkgFill getLeaderCnt getStyle getTxtRot getTxtStr getTxtWidth getScaleFactor getTextFrameDisplay ldxf10_1 ldxf10_2 ldxf10_3 lstpts lstptslen obj objnew sel var_cmdecho var_osmode) (defun *error* (errmsg) (and acDoc (vla-EndUndoMark acDoc)) (and errmsg (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " errmsg " >>\n")) ) (setvar 'cmdecho var_cmdecho) (setvar 'osmode var_osmode) ) (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object))) (or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc)) (setq var_cmdecho (getvar "cmdecho")) (setq var_osmode (getvar "osmode")) (setvar 'cmdecho 0) (setvar 'osmode 0) (setq ss1 (ssget '((0 . "MULTILEADER")))) (setq sel (ssadd)) (setq sel_mls_not_compat (ssadd)) (setq cnt 0) (repeat (setq cnt (sslength ss1)) (setq cnt (1- cnt)) (setq en (_dxf -1 (entget (ssname ss1 cnt))) endata (entget en) obj (vlax-ename->vla-object en) getLay (vla-get-Layer obj) getScaleFactor (vla-get-ScaleFactor obj) getStyle (vla-get-StyleName obj) getTextFrameDisplay (vla-get-TextFrameDisplay obj) getTxtBkgFill (vla-get-TextBackGroundFill obj) getTxtJustify (vla-get-TextJustify obj) getTxtRot (vla-get-TextRotation obj) getTxtStr (vla-get-TextString obj) getTxtWidth (vla-get-TextWidth obj) lstpts (vl-remove-if-not '(lambda (p) (eq (car p) 10)) (reverse endata) ) lstptslen (length lstpts) ldxf10_1 (cdr (nth 1 (reverse lstpts))) ldxf10_2 (cdr (nth 3 (reverse lstpts))) ldxf10_3 (cdr (nth 2 (reverse lstpts))) getLeaderCnt (vla-get-LeaderCount obj) ) ;; setq (cond ((or (> lstptslen 5) (< lstptslen 4)) (ssadd en sel_mls_not_compat) ) ((or (= lstptslen 5) (= lstptslen 4)) (progn (if (= lstptslen 5) (command "_.MLEADER" "_H" "_L" "_O" "_M" 3 "_X" "_non" (trans ldxf10_1 0 1) "_non" (trans ldxf10_2 0 1) "_non" (trans ldxf10_3 0 1) "" ) ) (if (= lstptslen 4) (command "_.MLEADER" "_H" "_L" "_O" "_M" 2 "_X" "_non" (trans ldxf10_1 0 1) "_non" (trans ldxf10_3 0 1) "" ) ) (setq entnew (entlast) objnew (vlax-ename->vla-object entnew) ) (if en (progn (if (/= getTxtWidth 0) (vla-put-TextWidth objnew (/ getTxtWidth getScaleFactor)) ;; Testing the dividing the text width by the scale factor of the old mleader. ) (vla-put-TextBackGroundFill objnew getTxtBkgFill) (vla-put-TextJustify objnew getTxtJustify) (vla-put-Layer objnew getLay) (vla-put-ScaleFactor objnew getScaleFactor) (vla-put-StyleName objnew getStyle) (vla-put-TextFrameDisplay objnew getTextFrameDisplay) (vla-put-TextRotation objnew getTxtRot) (vla-put-TextString objnew getTxtStr) (entdel en) (ssadd entnew sel) ) ) ) ) ) ) ;; repeat (if (> (sslength sel) 0) (progn (princ (strcat "\n: ------------------------------\n\t\t<<< You've created " (itoa (sslength sel)) (if (> (sslength sel) 1) " new MULTILEADERS" " new MULTILEADER") ". A legend has been born >>>\n: ------------------------------\n" ) ) (sssetfirst nil sel) ) ) (if (and sel (> (sslength sel_mls_not_compat) 0)) (progn (princ (strcat "\n: ------------------------------\n\t\t*** Program found " (itoa (sslength sel_mls_not_compat)) (if (> (sslength sel_mls_not_compat) 1) " MULTILEADERS that are" " MLEADER that is" ) " not compatible ***\n: ------------------------------\n" ) ) (princ (strcat "\n: ------------------------------\n\t\t*** NOTE: " (itoa (sslength sel)) (if (> (sslength sel) 1) " successfully converted MULTILEADERS have been" " successfully converted MULTILEADER has been" ) " selected ***\n: ------------------------------\n" ) ) ) ) (*error* nil) (princ) ) ;; end MR defun ;; ----------------------------------------------------------------------- ;; ----------------------=={ Functions START }==-------------------------- ;;----------------------------------------------------------------------;; ;; _dxf ;; Finds the association pair, strips 1st element ;; args - dxfcode elist ;; Example - (_dxf -1 (entget (ssname (ssget) 0))) ;; Returns - <Entity name: xxxxxxxxxxx> (defun _dxf (code elist) (cdr (assoc code elist)) ) ;; ----------------------------------------------------------------------- ;; ---------------------=={ Functions END }==-- -------------------------- (princ (strcat "\n: ------------------------------\n\"3dwannab_MLEADER_Recreate.lsp\" loaded | Version " *MLEADER_Recreate-Ver* " by 3dwannab. Type \"MLEADER_Recreate\" OR \"MR\" to run.\n: ------------------------------\n" ) ) (princ) ;; ----------------------------------------------------------------------- ;; -------------------=={ MLEADER_Recreate END }==------------------------ ; (c:MR) ;; Uncommet for testing
    1 point
  5. @3dwannab What want to change https://help.autodesk.com/view/OARX/2022/ENU/?guid=GUID-95FD33C2-DF78-4014-933C-9AC124E6A35D
    1 point
  6. (defun c:pp() (setq BlockName (getstring "Enter a block name: " )) (setq ssp (ssget '((0 . "LWPOLYLINE")))) (repeat (setq i (sslength ssp)) (setq p (entget (ssname ssp (setq i (1- i)))) a (assoc 10 p) b (assoc 10 (cdr (member a p))) c (mapcar '(lambda (x y) (* 0.5 (+ x y))) (setq a (cdr a)) (setq b (cdr b))) ) (entmake (list (cons 0 "INSERT") (cons 10 c) (cons 2 BlockName)(cons 50 (angle a b)))) ) ) Not sure what "align on polylines" means. I use the first two points of polylines to place the block. This could be wrong if the polyline starts with an arc... There is no error trap in this Lisp, so when prompted, enter a valid block name.
    1 point
  7. IDK what kinda of mleader your using but this is what dumps when selecting one. (RO) = Read Only and can only use vla-get ; IAcadMLeader 3d8a0ae0 : TeighaX Multi-Leader Interface ; Property values : ; Application (RO) = #<VLA-OBJECT IAcadApplication 000000002670DAF0> ; ArrowheadBlock = "" ; ArrowheadSize = 0.18 ; ArrowheadType = 0 ; BlockConnectionType = 0 ; BlockScale = 1.0 ; color = 256 ; ContentBlockName = "" ; ContentBlockType = 6 ; ContentType = 2 ; Database (RO) = #<VLA-OBJECT IAcadDatabase 000000003DF087E8> ; Document (RO) = #<VLA-OBJECT IAcadDocument 000000003D8D33E8> ; DogLegged = -1 ; DoglegLength = 0.36 ; EntityName (RO) = "AcDbMLeader" ; EntityType (RO) = NIL ; Handle (RO) = "81" ; HasExtensionDictionary (RO) = -1 ; Hyperlinks (RO) = #<VLA-OBJECT IAcadHyperlinks 000000003DF7D9A8> ; LandingGap = 0.09 ; Layer = "0" ; LeaderCount (RO) = 1 ; LeaderLineColor = #<VLA-OBJECT IAcadAcCmColor 000000000299F328> ; LeaderLineType = "" ; LeaderLineWeight = -2 ; LeaderType = 1 ; Linetype = "ByLayer" ; LinetypeScale = 1.0 ; Lineweight = -1 ; Material = "ByLayer" ; ObjectID (RO) = 44195888 ; ObjectID32 (RO) = 44195888 ; ObjectName (RO) = "AcDbMLeader" ; OwnerID (RO) = 1034257008 ; OwnerID32 (RO) = 1034257008 ; PlotStyleName = "ByLayer" ; ScaleFactor = 1.0 ; StyleName = "Standard" ; TextAttachmentDirection = 0 ; TextBackgroundFill = 0 ; TextBottomAttachmentType = 0 ; TextDirection = 1 ; TextFrameDisplay = 0 ; TextHeight = 0.18 ; TextJustify = 1 ; TextLeftAttachmentType = 1 ; TextLineSpacingDistance = NIL ; TextLineSpacingFactor = 1.0 ; TextLineSpacingStyle = 1 ; TextRightAttachmentType = 3 ; TextRotation = 0.0 ; TextString = "" ; TextStyleName = "Standard" ; TextTopAttachmentType = 0 ; TextWidth = 0.0 ; TrueColor = #<VLA-OBJECT IAcadAcCmColor 000000000299FF28> ; Visible = -1 ; ; Methods supported : ; AddLeader () ; AddLeaderLine (2) ; AddLeaderLineEx (1) ; ArrayPolar (3) ; ArrayRectangular (6) ; Copy () ; Delete () ; Erase () ; GetBlockAttributeValue (1) ; GetBlockAttributeValue32 (1) ; GetBoundingBox (2) ; GetDoglegDirection (1) ; GetExtensionDictionary () ; GetLeaderIndex (1) ; GetLeaderLineIndexes (1) ; GetLeaderLineVertices (1) ; GetVertexCount (1) ; GetXData (3) ; Highlight (1) ; IntersectWith (2) ; Mirror (2) ; Mirror3D (3) ; Move (2) ; RemoveLeader (1) ; RemoveLeaderLine (1) ; Rotate (2) ; Rotate3D (3) ; ScaleEntity (2) ; SetBlockAttributeValue (2) ; SetBlockAttributeValue32 (2) ; SetDoglegDirection (2) ; SetLeaderLineVertices (2) ; SetXData (2) ; TransformBy (1) ; Update ()
    1 point
  8. Isn't it rather the TextJustify property you want to get instead of TextAlignmentType?
    1 point
  9. Hi @Steven P I looked but didn't find any... Thanks, aridzv
    1 point
×
×
  • Create New...