Help with Edit a Lisp

Help with Edit a Lisp

chan230984
Advocate Advocate
848 Views
3 Replies
Message 1 of 4

Help with Edit a Lisp

chan230984
Advocate
Advocate

Hi all , I has lisp But I want to help Change  Rotate text In position as in the picture and want to remove Arrow

Please Help

Thanks

 

Untitled.png

 

(defun LM:UnFormat ( str mtx / _replace rx )
(defun _replace ( new old str )
(vlax-put-property rx 'pattern old)
(vlax-invoke rx 'replace str new)
)
(if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
(progn
(setq str
(vl-catch-all-apply
(function
(lambda ( )
(vlax-put-property rx 'global actrue)
(vlax-put-property rx 'multiline actrue)
(vlax-put-property rx 'ignorecase acfalse)
(foreach pair
'(
("\032" . "\\\\\\\\")
(" " . "\\\\P|\\n|\\t")
("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
("$1$2" . "\\\\(\\\\S)|[\\\\](})|}")
("$1" . "[\\\\]({)|{")
)
(setq str (_replace (car pair) (cdr pair) str))
)
(if mtx
(_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
(_replace "\\" "\032" str)
)
)
)
)
)
(vlax-release-object rx)
(if (null (vl-catch-all-error-p str))
str
)
)
)
)
(vl-load-com)
(defun c:chm ( / level p0 p1)
(setvar "cmdecho" 0)
(command "._undo" "_begin")
(if (and (setq level (atof (LM:UnFormat (cdr (assoc 1 (entget (car (entsel "\nFirst level: "))))) nil)))
(setq p1 (getpoint "\nSpecify first level position: "))
)
(progn
(setq p0 p1)
(command "._leader" p1 "@0.65<45" "" (strcat "EL=" (rtos level 2 3)) "")

(while (setq p1 (getpoint "\nSpecify next level position: "))
(command "._leader" p1 "@0.65<45" "" (strcat "EL=" (rtos (+ level (- (cadr p1) (cadr p0))) 2 3)) "")
)
); progn
); if
(command "._undo" "_end")
(setvar "cmdecho" 1)
(princ)
)

0 Likes
Accepted solutions (1)
849 Views
3 Replies
Replies (3)
Message 2 of 4

ВeekeeCZ
Consultant
Consultant

Maybe like this.

(defun LM:UnFormat ( str mtx / _replace rx )
  (defun _replace ( new old str )
    (vlax-put-property rx 'pattern old)
    (vlax-invoke rx 'replace str new)
    )
  (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
    (progn
      (setq str
	     (vl-catch-all-apply
	       (function
		 (lambda ( )
		   (vlax-put-property rx 'global     actrue)
		   (vlax-put-property rx 'multiline  actrue)
		   (vlax-put-property rx 'ignorecase acfalse)
		   (foreach pair
			    '(
			      ("\032"    . "\\\\\\\\")
			      (" "       . "\\\\P|\\n|\\t")
			      ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
			      ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
			      ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
			      ("$1"      . "[\\\\]({)|{")
			      )
		     (setq str (_replace (car pair) (cdr pair) str))
		     )
		   (if mtx
		     (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
		     (_replace "\\"   "\032" str)
		     )
		   )
		 )
	       )
	    )
      (vlax-release-object rx)
      (if (null (vl-catch-all-error-p str))
	str
	)
      )
    )
  )
(vl-load-com)
(defun c:chm ( / level p0 p1)
  (setvar "cmdecho" 0)
  (command "._undo" "_begin")
  (if (and (setq level (atof (LM:UnFormat (cdr (assoc 1 (entget (car (entsel "\nFirst level: "))))) nil)))
	   (setq p1 (getpoint "\nSpecify first level position: "))
	   )
    (progn
      (setq p0 p1)
      (entmakex (list (cons 0 "TEXT")
			(cons 10  p1)
			(cons 11  p1)
			(cons 40 (getvar 'textsize))
			(cons 50 (/ pi 2))
			(cons 71 0)
			(cons 72 1)
		      (cons 73 1)
			(cons 1 (rtos level 2 3))))
      
      (while (setq p1 (getpoint "\nSpecify next level position: "))
	(entmakex (list (cons 0 "TEXT")
			(cons 10  p1)
			(cons 11  p1)
			(cons 40 (getvar 'textsize))
			(cons 50 (/ pi 2))
			(cons 71 0)
			(cons 72 1)
			(cons 73 1)
			(cons 1 (rtos level 2 3))))
	)
      ); progn
    ); if
  (command "._undo" "_end")
  (setvar "cmdecho" 1)
  (princ)
  )
0 Likes
Message 3 of 4

chan230984
Advocate
Advocate

@ВeekeeCZ 

Not right

Untitled.png

0 Likes
Message 4 of 4

ВeekeeCZ
Consultant
Consultant
Accepted solution

I see..

(defun LM:UnFormat ( str mtx / _replace rx )
  (defun _replace ( new old str )
    (vlax-put-property rx 'pattern old)
    (vlax-invoke rx 'replace str new)
    )
  (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
    (progn
      (setq str
	     (vl-catch-all-apply
	       (function
		 (lambda ( )
		   (vlax-put-property rx 'global     actrue)
		   (vlax-put-property rx 'multiline  actrue)
		   (vlax-put-property rx 'ignorecase acfalse)
		   (foreach pair
			    '(
			      ("\032"    . "\\\\\\\\")
			      (" "       . "\\\\P|\\n|\\t")
			      ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
			      ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
			      ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
			      ("$1"      . "[\\\\]({)|{")
			      )
		     (setq str (_replace (car pair) (cdr pair) str))
		     )
		   (if mtx
		     (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
		     (_replace "\\"   "\032" str)
		     )
		   )
		 )
	       )
	    )
      (vlax-release-object rx)
      (if (null (vl-catch-all-error-p str))
	str
	)
      )
    )
  )
(vl-load-com)
(defun c:chm ( / level p0 p1)
  (setvar "cmdecho" 0)
  (command "._undo" "_begin")
  (if (and (setq level (atof (LM:UnFormat (cdr (assoc 1 (entget (car (entsel "\nFirst level: "))))) nil)))
	   (setq p1 (getpoint "\nSpecify first level position: "))
	   )
    (progn
      (setq p0 p1)
      (entmakex (list (cons 0 "TEXT")
			(cons 10  p1)
			(cons 11  p1)
			(cons 40 (getvar 'textsize))
			(cons 50 (/ pi 2))
			(cons 71 0)
			(cons 72 1)
		      (cons 73 1)
			(cons 1 (rtos level 2 3))))
      
      (while (setq p1 (getpoint "\nSpecify next level position: "))
	(entmakex (list (cons 0 "TEXT")
			(cons 10  p1)
			(cons 11  p1)
			(cons 40 (getvar 'textsize))
			(cons 50 (/ pi 2))
			(cons 71 0)
			(cons 72 1)
			(cons 73 1)
			(cons 1 (rtos (+ level (- (cadr p1) (cadr p0))) 2 3))))
	)
      ); progn
    ); if
  (command "._undo" "_end")
  (setvar "cmdecho" 1)
  (princ)
  )