Dien nguyen Posted August 26, 2023 Share Posted August 26, 2023 I'm searching the forums for how to create multileader, I found the following lisp to create it but they don't have Arrowhead installed, I tried with parameter: '("ArrowSymbol" . "LA-ARRW") , but it don't work. Can it be fixed? (defun CreateMLeaderStyle (CMS_NewName CMS_Config / CMS_TextStyle CMS_MLeaderStyles CMS_NewMLeaderStyle CMS_Property CMS_ColorObject) (if (or (and (setq CMS_TextStyle (cdr (assoc "TextStyle" CMS_Config))) (tblsearch "STYLE" CMS_TextStyle) ) (not (cdr (assoc "TextStyle" CMS_Config))) ) (progn (setq CMS_MLeaderStyles (vla-item (vla-get-Dictionaries (vla-get-ActiveDocument (vlax-get-acad-object))) "ACAD_MLEADERSTYLE")) (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list CMS_MLeaderStyles CMS_NewName))) (progn (setq CMS_NewMLeaderStyle (vla-AddObject CMS_MLeaderStyles CMS_NewName "AcDbMLeaderStyle")) (if (not (cdr (assoc "TextStyle" CMS_Config))) (vla-put-TextStyle CMS_NewMLeaderStyle (getvar "TEXTSTYLE")) ) (foreach CMS_Item CMS_Config (if (and (vl-consp CMS_Item) (= (type (setq CMS_Property (car CMS_Item))) 'STR) (not (listp (cdr CMS_Item))) (vlax-property-available-p CMS_NewMLeaderStyle CMS_Property) ) (cond ( (wcmatch (strcase CMS_Property) "*COLOR*") (setq CMS_ColorObject (vlax-get-property CMS_NewMLeaderStyle CMS_Property)) (vla-put-ColorIndex CMS_ColorObject (cdr CMS_Item)) (vl-catch-all-apply 'vlax-put-property (list CMS_NewMLeaderStyle CMS_Property CMS_ColorObject)) ) ( T (vl-catch-all-apply 'vlax-put-property (list CMS_NewMLeaderStyle CMS_Property (cdr CMS_Item))) ) ) ) ) (princ (strcat "\n ** Created " CMS_NewName " MLeader style")) ) (princ "\n ** Error: MLeader style already exists") ) ) (princ "\n ** Error: textstyle does not exist") ) (princ) ) ;MLeaderLandingDistance (defun MLeaderLandingDistance ( sty flg / dic ) (and (setq dic (dictsearch (namedobjdict) "acad_mleaderstyle")) (setq dic (dictsearch (cdr (assoc -1 dic)) sty)) (entmod (subst (cons 43 ((if flg + -) (abs (cdr (assoc 43 dic))))) (assoc 43 dic) dic)) ) ) (defun c:MMN () (setq txt (tblsearch "style" "L-ARIAL") ) (if (null txt) (progn (command "_-style" "L-ARIAL" "Arial.ttf" "0.0" "1.0" "0" "" "") ) ) (CreateMLeaderStyle "L-TAG-TEXT" (list '("ArrowSize" . 2) '("ArrowSymbol" . "Dot") '("DoglegLength" . 3) '("LandingGap" . 1) '("LeaderLineColor" . 256) (cons "ScaleFactor" 1) '("TextColor" . 256) '("TextHeight" . 2) '("TextLeftAttachmentType" . 1) '("TextRightAttachmentType" . 1) '("TextStyle" . "L-ARIAL") ) ) (princ) (command "cmleaderstyle" "L-TAG-TEXT") ;;;;;;==================================== (MLeaderLandingDistance (getvar 'cmleaderstyle) nil) ) Quote Link to comment Share on other sites More sharing options...
Dien nguyen Posted August 27, 2023 Author Share Posted August 27, 2023 (edited) I find another way to create multileader in lisp below, but how find another properties in multileader such as landing distance, color? (defun c:MM () (style "L-TAG-SHRUBS" 2) (MLeaderLandingDistance (getvar 'cmleaderstyle) t) ) (defun style (styleName asize) (setq txt (tblsearch "style" "L-ARIAL")) (if (null txt) (progn (command "_-style" "L-ARIAL" "Arial.ttf" "0.0" "1.0" "0" "" "") ) ) (setq newleaderstyle (vla-AddObject (vla-item (vla-get-Dictionaries (vla-get-ActiveDocument (vlax-get-acad-object))) "ACAD_MLEADERSTYLE") stylename "AcDbMLeaderStyle")) (vla-put-ArrowSymbol newleaderstyle "KL-ARRW") (vla-put-ArrowSize newleaderstyle asize) (vla-put-TextLeftAttachmentType newleaderstyle "1") (vla-put-TextRightAttachmentType newleaderstyle "1") (vla-put-TextStyle newleaderstyle "L-ARIAL") (vla-put-TextHeight newleaderstyle "2") (command "cmleaderstyle" styleName) ) Edited August 27, 2023 by Dien nguyen Quote Link to comment Share on other sites More sharing options...
lido Posted August 27, 2023 Share Posted August 27, 2023 Try this: ;;Draw leader and text inside circle (DEFUN C:LEADBBL (/ *error* _Common _Getkword ACD BOX C67 CLA CTB DIA DIC DIS DMC DMH DMS DMY DSO FDS FIL LDI POS PT1 PT2 PT3 PTE PTW RAD RGT SRT TXT ) (defun *error* (s) (if (and PT2 (not PT3)) (redraw)) (if (and ACD DSO DMS) (vla-put-activedimstyle ACD (vla-item DIC DMS))) (if DIC (vlax-release-object DIC)) (if ACD (vlax-release-object ACD)) (or (wcmatch (strcase s) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\nError: " s))) (princ) ) (defun _Common (nume) (mapcar (function cons) (quote (0 100 67 410 8)) (list nume "AcDbEntity" C67 CTB CLA) ) ) (defun _Getkword (Ini Def Esc Msg / lies lopt noli stop) (prompt Msg) (setq lies (list (quote (2 13)) (quote (2 32))) Ini (mapcar (function (lambda (x) (list 2 (ascii x)))) Ini) ) (while (not stop) (setq noli (vl-catch-all-error-p (setq lopt (vl-catch-all-apply (function grread) (list nil 8)))) stop (cond ( noli Esc) ( (or (= (car lopt) 25) (vl-position lopt lies)) Def) ( (vl-position lopt Ini) (princ (chr (cadr lopt)))) ( T (if (= (car lopt) 2) (princ (chr (cadr lopt)))) (prompt (strcat "\nInvalid option." Msg))) ) ) ) (strcase stop) ) (setq CTB (if (= (getvar "CVPORT") 1) (getvar "CTAB") "Model") C67 (if (= CTB "Model") 0 1) CLA (getvar "CLAYER") DMS (getvar "DIMSTYLE") ACD (vla-get-activedocument (vlax-get-acad-object)) DIC (vla-get-dimstyles ACD) FIL (vl-filename-mktemp (substr (rtos (getvar "CDATE") 2 8) 10) nil ".tmp") ) (vlax-for itm DIC (setq LDI (cons (vla-get-name itm) LDI))) (setq LDI (acad_strlsort LDI)) (if (= (_Getkword (quote ("n" "N" "y" "Y")) "N" "N" (strcat "\nCurrent Dimension Style \"" DMS "\" settings will be used. Select another Dimension Style [Yes/No] <No>: ")) "Y") (if (setq FDS (open FIL "w")) (progn (write-line (strcat "DimStyle:dialog{label=\"Dimension Style selection\";initial_focus=\"Dims\";:row{:boxed_row{label=\"Available Dimension Styles\";:list_box{key=\"Dims\";height=8;width=" (itoa (+ (apply (function max) (mapcar (function strlen) LDI)) 2)) ";}}:column{alignment=bottom;fixed_height=true;:button{label=\"&OK\";key=\"DoIt\";is_default=true;width=14;fixed_width=true;height=2;}:spacer{height=0.25;}:button{label=\"&Cancel\";key=\"Cancel\";is_cancel=true;width=14;fixed_width=true;height=2;}}}}" ) FDS ) (setq FDS (close FDS) DIA (load_dialog FIL) POS (itoa (vl-position DMS LDI)) ) (new_dialog "DimStyle" DIA) (start_list "Dims") (foreach el LDI (add_list el)) (end_list) (set_tile "Dims" POS) (action_tile "Dims" "(setq POS $value)") (action_tile "DoIt" "(done_dialog 1)") (action_tile "Cancel" "(done_dialog 0)") (setq SRT (start_dialog)) (unload_dialog DIA) (vl-file-delete FIL) (if (and (= SRT 1) (/= (vl-position DMS LDI) (atoi POS))) (progn (setq DSO (nth (atoi POS) LDI)) (vla-put-activedimstyle ACD (vla-item DIC DSO)) ) ) ) (alert (strcat "Unable to write data to folder \"" (vl-filename-directory FIL) "\". Current Dimension Style \"" DMS "\" settings will be used.")) ) ) (setq DMC (getvar "DIMCLRD") DMH (getvar "DIMTXT") DMY (getvar "DIMTXSTY") ) (initget 1) (setq PT1 (getpoint "\nLeader start point: ")) (initget 1) (setq PT2 (getpoint PT1 "\nLeader second point: ")) (grdraw PT1 PT2 (if (vl-position DMC (quote (0 256))) (vla-get-color (vla-item (vla-get-layers ACD) CLA)) DMC)) (initget 1) (setq PT3 (getpoint PT2 "\nX coordinate of the Leader last point: ") DIS (distance PT2 (list (car PT3) (cadr PT2) (caddr PT2))) PTE (polar PT2 0 DIS) PTW (polar PT2 pi DIS) RGT (< (car PT2) (car PT3)) ) (redraw) (entmake (append (_Common "LEADER") (list (cons 62 DMC) (quote (100 . "AcDbLeader")) (cons 3 (cond (DSO) (DMS))) (cons 10 PT1) (cons 10 PT2) (cons 10 (if RGT PTE PTW)) ) ) ) (if (and (setq TXT (getstring T "\nAnnotation text: ")) (vl-remove 32 (vl-string->list TXT)) ) (progn (setq BOX (textbox (list (cons 1 TXT) (cons 7 DMY) (cons 40 DMH))) RAD (fix (+ 0.5 (max 0.5 (* 0.9 DMH) (* 0.525 (distance (car BOX) (cadr BOX)))))) PT1 (if RGT (polar PTE 0 RAD) (polar PTW pi RAD)) ) (entmake (append (_Common "CIRCLE") (list (cons 62 DMC) (quote (100 . "AcDbCircle")) (cons 10 PT1) (cons 40 RAD) ) ) ) (entmake (append (_Common "TEXT") (list (cons 62 (getvar "DIMCLRT")) (quote (100 . "AcDbText")) (cons 10 PT1) (cons 40 DMH) (cons 1 TXT) (quote (50 . 0.)) (cons 41 (vla-get-width (vla-item (vla-get-textstyles ACD) DMY))) (quote (51 . 0.)) (cons 7 DMY) (quote (71 . 0)) (quote (72 . 1)) (cons 11 PT1) (quote (73 . 2)) ) ) ) ) ) (if DSO (vla-put-activedimstyle ACD (vla-item DIC DMS))) (vlax-release-object DIC) (vlax-release-object ACD) (princ) ) ;;C:LEADBBL 2 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.