Jump to content

make objects as block


blueshake

Recommended Posts

hi,all

when I draw a arrow ,line and text ,then I want to make them become a block

and I want to add the following attribute to the block.as the picture describe.

any clues to do this? thanks.

1745_1289656077U4mQ.png

Link to comment
Share on other sites

the attribute are:

1.when I move the text ,the underline will move.

2.when I edit the text, the length of underline can changed according the length of text.

3.as the same of 1 ,when I move the underline , the text can move to .

 

actually it is something similar to mleader in autocad.

Link to comment
Share on other sites

mleader is a choice.but it is subjected to the style of mleader???

in mechanic drawing,there are many situation which to make a dimension for “angle of chamfer”.

if I want to use mleader with a lisp command ,what should I do?

e.g.

(command "_.mleader" ...;what is the following?

Link to comment
Share on other sites

I know the following codes can be used to build block and insert block.but how to add "move" point to the block and make the text in block can be edited?

(entmake (list 
           (cons '0 "BLOCK") 
           (cons '2 "*U") 
           (cons '70 1) 
           (cons '10 ip)
         ))
         (setq th (setq tmp le))
         (while (setq tmp (entnext tmp))
           (entmake (entget tmp))
         ) 
         (setq tmp (entmake (list (cons '0 "ENDBLK"))))
         (while (setq th (entnext th))
           (entdel th)
         ) 
         (entdel le)
         (setq le nil)
         (entmake (list 
           (cons '0 "INSERT") 
           (cons '2 tmp) 
           (cons '10 ip)
         ))

Link to comment
Share on other sites

  • 1 month later...

@Lee

I noticed that you have written a amazing lisp here.

 

can you improve this lisp to make the whole thing (lines circle text) as block .and can be edited.I mean ,when I move lines

the circle(text) can be moved together.and I change the size the text ,the circle beyond the text can auto enlarge???

Link to comment
Share on other sites

can you improve this lisp to make the whole thing (lines circle text) as block .and can be edited.I mean ,when I move lines

the circle(text) can be moved together.and I change the size the text ,the circle beyond the text can auto enlarge???

 

Thanks BlueShake - but that's an old program with pretty bad code - I updated it a bit here.

 

But really, for what you want to achieve, you would be better using a Dynamic Block. In fact, I believe there are already preset Dynamic Blocks available through the default Tool Palettes which will do exactly what you want - look under the Anotation Tab.

 

Lee

Link to comment
Share on other sites

@Lee

for two reasons.

one is I want to know how cad(or you cad lisp master) do this magic.and the second is as followed picture.

the gap between text and line can not be set for Chinese words.it is annoying . I have read many post.and

can not figure out how to change this.

 

2010-12-28185607.png?t=1293533959

Link to comment
Share on other sites

the gap between text and line can not be set for Chinese words.it is annoying .

For russian text too.

attachment.php?attachmentid=15479&stc=1&thumb=1&d=1233591828

To raise the shelf above the text using the formatting \\pxse

Manually do this for a long time, so they beat written by several command. Maybe this would really work for Chinese.

MTLS - changes the line spacing. mode "a few" (format \\pxsm)

MTLE - changes the line spacing. mode is "exactly" (format \\pxse)

VLR_MTLE_ON - start (activate) reactor multilider

VLR_MTLE_OFF - stop (deactivate) a reactor

Sign of activity of the reactor - a line * LE * in modemacro (if anyone is not clear - on the left bottom of the screen)

Try to use MTLE, VLR_MTLE_ON, VLR_MTLE_OFF command

;;; http://forum.dwg.ru/showthread.php?t=26548&page=3
[color="red"];;; Where to change the value of the interval between lines of paragraph
;;; in the reactor at multilider?
;;; search line (mtext-paragraph "\ \ pxse" 0.86667 (entlast))
;;; it change the number of 0.86667 to the desired[/color]

(defun le-endCommand (CALL CALLBACK)
 (if (= (strcase (car CALLBACK)) "MLEADER")
 (mtext-paragraph "\\pxse" [b][size="4"][color="red"]0.86667[/color][/size][/b] (entlast)) [b][color="red"];;; This changes the value of line spacing section![/color][/b]
)
)

(defun gc:FieldCode (ent / foo elst xdict dict field str)
 ;; credits gile
 (defun foo (field str / pos fldID objID)
   (setq pos 0)
   (if (setq pos (vl-string-search "\\_FldIdx " str pos))
     (while (setq pos (vl-string-search "\\_FldIdx " str pos))
       (setq fldId (entget (cdr (assoc 360 field)))
             field (vl-remove (assoc 360 field) field)
             str   (strcat
                     (substr str 1 pos)
                     (if (setq objID (cdr (assoc 331 fldId)))
                       (vl-string-subst
                         (strcat "ObjId " (itoa (gc:EnameToObjectId objID)))
                         "ObjIdx"
                         (cdr (assoc 2 fldId))
                       )
                       (foo fldId (cdr (assoc 2 fldId)))
                     )
                     (substr str (1+ (vl-string-search ">%" str pos)))
                   )
       )
     )
     str
   )
 )
   ;; gc:EnameToObjectId (gile)
;; Returns the ObjectID from an ename
;;
;; Argument : an ename

(defun gc:EnameToObjectId (ename)
 ;; credits gile
 ((lambda (str)
    (hex2dec
      (substr (vl-string-right-trim ">" str) (+ 3 (vl-string-search ":" str)))
    )
  )
   (vl-princ-to-string ename)
 )
)
   ;;============================================================;;

;; hex2dec (gile)
;; convert an hexadecimal into a decimal (int)
;;
;; Argument : un hexadedimal (string)

(defun hex2dec (s / r l n)
 (setq	r 0 l (vl-string->list (strcase s)))
 (while (setq n (car l))
   (setq l (cdr l)
         r (+ (* r 16) (- n (if (<= n 57) 48 55)))
   )
 )
)
 ;;--------------------------------------------------------;;
 
 (setq elst (entget ent))
 (if (vlax-property-available-p (vlax-ename->vla-object ent) 'Textstring)
   (setq str (vla-get-TextString (vlax-ename->vla-object ent)))
   )
 (if (and
(member (cdr (assoc 0 elst)) '("ATTRIB" "MTEXT" "TEXT" "MULTILEADER"))
(setq xdict (cdr (assoc 360 elst)))
(setq dict (dictsearch xdict "ACAD_FIELD"))
(setq field (dictsearch (cdr (assoc -1 dict)) "TEXT"))
     )
   (setq str (foo field (cdr (assoc 2 field))))
 )
   str
)
(defun isFieldAvailable ( obj  / fc )
 (if (= (type obj) 'ENAME)
     (setq obj (vlax-ename->vla-object obj))
   )
 (and
   (setq fc (vla-GetExtensionDictionary  obj))
   (setq fc (vlax-vla-object->ename fc))
   (dictsearch fc "ACAD_FIELD")
   )
)
(defun mtext-paragraph ( pat value obj / ss i mtext ent)
;;; Изменить межстрочный интервал мтекста и многострочных аттрибутов
;;; Change Line Spacing
;;; http://forum.dwg.ru/showthread.php?t=54857
;;; Измените значение системной переменной ATTIPE на 1 и будет
;;; в редакторе многострочных атрибутов полноценный вариант редактора
;;; pat "\\pxse" or "\\pxsm"
;;; value - koeff like 0.86667
;;; obj - ename or vla object
 (vl-load-com)
 (setq value (rtos value 2 5))
 (if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
 (setq ent (vlax-vla-object->ename obj))
 (if (and (vlax-write-enabled-p obj)
       (vlax-property-available-p obj 'Textstring)
                (or (not (vlax-property-available-p obj 'MTextAttribute))
                    (and (vlax-property-available-p obj 'MTextAttribute)
                         (eq (vla-get-MTextAttribute obj) :vlax-true)
                         )
                    )
                )
         (progn
           (setq mtext (gc:FieldCode ent))
           (if (not(setq i (vl-string-search "\\PX" (strcase mtext))))
             (setq i 0)
             )
           (if (wcmatch (strcase (substr mtext (1+ i) 3)) "\\PX")  
             (setq mtext
                 (strcat (if (not (zerop i))(substr mtext 1 i) "")
                 pat value ";"
                 (substr mtext (+ 2 (vl-string-search ";" mtext i))))
                   )
             (setq mtext (strcat pat value ";" mtext))
             )
           (vla-put-TextString obj mtext)
           (if (isFieldAvailable obj)
             (progn
               (vl-cmdf "_.updatefield" ent "")
               (entupd ent)
               )
             )
           )
       )
 )

(defun C:MTLS ( / ss i lst mtext ls *LS*)
;;; MText Line Spacing
;;; Change line spacing mtext and multi-attribute
;;; Change Line Spacing
;;; Http://forum.dwg.ru/showthread.php?t=54857
;;; Change the value of system variable ATTIPE at 1 and will
;;, the editor of multi-attributes high-grade version of the editor  (vl-load-com)
 (if (zerop
     (setq
       *LS* (abs
              (atof (vl-princ-to-string (getcfg "AppData/MTEXTLS/LS")))
            ) ;_ end of abs
     ) ;_ end of setq
   ) ;_ end of zerop
 (setq *LS* 1)
) ;_ end of if
 (if (and
       (progn
         (initget 6)
         (princ "\nEnter line spasing value <")
         (princ *LS*)
         (princ ">: ")
         (if (setq ls (getreal))
           (progn
             (setq *LS* ls)
             (setcfg "AppData/MTEXTLS/LS" (rtos *LS* 2 2))
             )
           (setq ls *LS*)
           )
       )
       (setq lst nil ss (ssget "_:L" '((0 . "MTEXT,ATTDEF,INSERT,MULTILEADER"))))
       (repeat (setq i (sslength ss)) ;_ end setq
        (setq lst (cons (ssname ss (setq i (1- i))) lst))
        ) ;_ en
       )
   (progn
     (setq ss nil)
     (foreach itm lst
       (if (and itm (setq itm (vlax-ename->vla-object itm))
          (vlax-property-available-p itm 'Hasattributes)
   (eq :vlax-true (vla-get-HasAttributes itm))
                )
         (setq ss (append ss
                          (mapcar 'vlax-vla-object->ename
                          (append (vlax-invoke itm 'Getattributes)(vlax-invoke itm 'Getconstantattributes))
                                  )
                          )
               )
	  )
       )
     (setq lst (append lst ss))
     (foreach itm lst (mtext-paragraph "\\pxsm" ls itm))
   )
   )
 (princ)
)
(defun C:MTLE ( / ss i lst mtext ls *LE*)
;;; MText Line Equal
;;; Change line spacing mtext and multi-attribute
;;; Change Line Equal
;;; Http://forum.dwg.ru/showthread.php?t=54857
;;; Change the value of system variable ATTIPE at 1 and will
;;, the editor of multi-attributes high-grade version of the editor
 (vl-load-com)
 (if (zerop
     (setq
       *LE* (abs
              (atof (vl-princ-to-string (getcfg "AppData/MTEXTLS/LE")))
            ) ;_ end of abs
     ) ;_ end of setq
   ) ;_ end of zerop
 (setq *LE* 1)
) ;_ end of if
 (if (and
       (progn
         (initget 6)
         (princ "\nEnter line spasing (equal) value <")
         (princ *LE*)
         (princ ">: ")
         (if (setq ls (getreal))
           (progn
             (setq *LE* ls)
             (setcfg "AppData/MTEXTLS/LE" (rtos *LE* 2 2))
             )
           (setq ls *LE*)
           )
       )
       (setq lst nil ss (ssget "_:L" '((0 . "MTEXT,ATTDEF,INSERT,MULTILEADER"))))
       (repeat (setq i (sslength ss)) ;_ end setq
        (setq lst (cons (ssname ss (setq i (1- i))) lst))
        ) ;_ en
       )
   (progn
     (setq ss nil)
     (foreach obj lst
       (if (and obj (setq obj (vlax-ename->vla-object obj))
          (vlax-property-available-p obj 'Hasattributes)
   (eq :vlax-true (vla-get-HasAttributes obj))
                )
         (setq ss (append ss
                          (mapcar 'vlax-vla-object->ename
                          (append (vlax-invoke obj 'Getattributes)(vlax-invoke obj 'Getconstantattributes))
                                  )
                          )
               )
	  )
       )
     (setq lst (append lst ss))
     (foreach itm lst (mtext-paragraph "\\pxse" ls itm))
   )
   )
 (princ)
)
 
 

(defun C:VLR_MTLE_ON ()
 (vl-load-com)
 (or *vlr-MTLE
    (setq *vlr-MTLE (vlr-command-reactor nil '((:vlr-commandEnded . le-endCommand)))))
 (princ "\nMtex Line Equal Reactor ON")
 (setvar "MODEMACRO" (strcat "*LE* "(VL-STRING-LEFT-TRIM "*LE* " (getvar "MODEMACRO"))))
 (princ)
)


;;  Turn the reactors off
(defun C:VLR_MTLE_OFF ()
 (and *vlr-MTLE (vlr-added-p *vlr-MTLE) (vlr-remove *vlr-MTLE))
 (setvar "MODEMACRO" (VL-STRING-LEFT-TRIM "*LE* " (getvar "MODEMACRO")))
 (princ "\nMtex Line Equal Reactor OFF")
 (princ)
)
(princ "\nType MTLE, MTLS, VLR_MTLE_ON, VLR_MTLE_OFF in command line")

 

 

PS. All the notes translated from Russian by machine translation. Hopefully, they translated adequately

Link to comment
Share on other sites

hi,VVA

first thank you for your codes.

I using your codes,and find the following problem.

I use mtle command and enter value "1", and it show left result in the picture.

but enter value "2" , and it show right result(which is wrong) in the picture.Do I miss something?? see the attached picture for more details.

2010-12-29222909.png

Link to comment
Share on other sites

but enter value "2"

Need to use the value in the 0.8 - 0.9. Try to specify a value of 0.86.

How to find the desired value formatting \ \ pxse?

1. Draw mleader with text height = 1

 

NBs6asc8.jpg

 

2. Use Line Spacing formatting

 

u6Qp9m2h.jpg

 

3. Find the value of paragraph line spacing. It will be

 

S7RxmtHL.jpg

 

4. For mleader with a few lines I use paragraph spacing to omit 2 and subsequent lines

 

czAMRvaa.jpg

 

Use MTLE command for existing mleader

Before drawing new mleader type the command VLR_MTLE_ON

Link to comment
Share on other sites

@VVX

 

I add the following codes in the last line of your codes.but cad give error with no such command.

 

(command "VLR_MTLE_ON")

Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...