Jump to content

Lisp help Selecting multi lines and labeling them

j_spawn_h

By j_spawn_h
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

  • Replies 28
  • Created
  • Last Reply

Top Posters In This Topic

  • fixo

    5

  • Smirnoff

    5

  • JBlom

    5

  • j_spawn_h

    4

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

Tharwat
Tharwat

Thanks for the encouragement .   So comments are welcome anytime .   (defun c:Lentxt (/ ss) (if (setq ss (ssget "_:L" '((0 . "LINE")))) ( (lambda (i / ss1 e dis pt1 pt2 pt3) (while

fixo
fixo

Hi , JB I will look at this later,   ~'J'~

Posted Images

JBlom Newbie

JBlom

Posted
Posted

Hello Fixo,

The latest change did not seem to yield correct rounding, 5" is the cutoff for rounding up. Lines that are less than XX'-5" are rounding down, lines that are greater than XX'-5" are rounding up. Any ideas how to fix this?

Thanks

JB

Link to comment
Share on other sites
  • 1 year later...
  • 1 year later...
sasiv Newbie

sasiv

Posted
Posted

Hello,

 

I am not familiar with Autolisp but this code was very useful for me. What would be even greater is if one more adjustment should exist: to put text above or below the line. I would appreciate if someone could put that in this code.

 

Regards

Sasa

Link to comment
Share on other sites
  • 5 years later...
  • 11 months later...
Kala Newbie

Kala

Posted
Posted
On 2/6/2011 at 11:52 AM, Tharwat said:

 

Thanks for the encouragement .:)

 

So comments are welcome anytime .

 

  

(defun c:Lentxt (/ ss)
 (if (setq ss (ssget "_:L" '((0 . "LINE"))))
   (
    (lambda (i / ss1 e dis pt1 pt2 pt3)
      (while
       (setq ss1 (ssname ss (setq i (1+ i))))
         (setq e (entget ss1 ))
      (setq dis (distance (setq pt1 (cdr (assoc 10 e)))(setq pt2 (cdr (assoc 11 e)))))
      (cond ((< (car pt1)(car pt2))
         (setq pt3 (polar pt1 (setq ang (angle pt1 pt2)) (/ dis 2.)))
         )
        ((> (car pt1)(car pt2))(setq pt3 (polar pt2 (setq ang (angle pt2 pt1)) (/ dis 2.)))
         )
      )
        (entmakex (list (cons 0 "TEXT")
              (cons 10 (polar pt3 ang 0))
                 (cons 1 (rtos dis 2))
               (cons 50 ang)
                     (cons 40 (getvar 'textsize))))  
        )
       )
    -1
   )
 (princ "\n No Line(s) selected")
 )
 (princ)
 )
 

Thanks.

 

Tharwat

hey is there some lisp like this to instead of getting lenght get me something from attribute?? ❤️ pleasseee help

Link to comment
Share on other sites
Tharwat Grand Master

Tharwat

Posted
Posted
On 9/21/2022 at 5:12 PM, Kala said:

hey is there some lisp like this to instead of getting lenght get me something from attribute?? ❤️ pleasseee help

You need to elaborate what you are after a bit further and if it is supported with a DWG then that would be much better.

Link to comment
Share on other sites
  • 1 year later...
Red Cedar Rookie

Red Cedar

Posted
Posted
On 2/6/2011 at 4:05 AM, Smirnoff said:

I slightly modified your code :)

 

  

(defun c:lmark(/ aDoc cTxt eLen ePar iAng iDr lPnt lSet oldSize sPar tWid)
 
 (vl-load-com)

 (defun Add_Masked_MText(Str Pt Hei Wid wiF Ang Mask
		  / oOsn cLay cTxt actSp nTxt
		  oDxf nDxf mPt xPt aDoc aSp lFlg)

 ; (Add_Masked_MText <Str> <Pt> <Hei> <Wid> <wiF> <Ang> <Mask>)
 
 (setq oOsn(getvar "OSMODE")
aDoc(vla-get-ActiveDocument
		(vlax-get-acad-object))
cLay (vla-get-ActiveLayer aDoc)
aSp(vla-get-ActiveSpace aDoc)
   ); end setq
   (if(= 1 aSp)
     (setq aSp(vla-get-ModelSpace aDoc))
     (setq aSp(vla-get-PaperSpace aDoc))
     ); end if
    (if(= :vlax-true(vla-get-Lock cLay))
   (progn
     (vla-put-Lock cLay :vlax-false)
     (setq lFlg T)
   ); end progn
); end if
    (if(= 1.0 wiF)
 (setq cTxt(strcat "\\pxqc;" Str))
 (setq cTxt(strcat "\\pxqc;{\\W" (rtos wiF) ";" Str "}"))
); end if
       (setq nTxt(vla-AddMText aSp
	    (vlax-3D-point '(0.0 0.0 0.0)) 1.0 cTxt))
(vla-put-Height nTxt Hei)
(vla-put-Width nTxt(+ Wid(/ Hei 2)))
(vla-put-BackgroundFill nTxt -1)
(setq oDxf(entget(vlax-vla-object->ename nTxt))
      nDxf(subst (cons 45 Mask)(assoc 45 oDxf)oDxf)
       ); end setq
 (entmod nDxf)
 (vla-getBoundingBox nTxt 'mPt 'xPt)
 (setq mPt(vlax-safearray->list mPt)
       xPt(vlax-safearray->list xPt)
       mPt(vlax-3d-point
	      (list(+(car mPt)(/(-(car xPt)(car mPt))2))
		 (+(cadr mPt)(/(-(cadr xPt)(cadr mPt))2))
			 0.0))
		); end setq
         (vla-Move nTxt mPt(vlax-3D-point Pt))
  (if(and(> Ang 0)(<= Ang pi))
     (vla-Rotate nTxt(vlax-3D-point Pt)(- Ang(/ pi 2)))
     (vla-Rotate nTxt(vlax-3D-point Pt)(+ Ang(/ pi 2)))
   ); end if
    (if lFlg
       (vla-put-Lock cLay :vlax-true)
     ); end if
  nTxt
 ); end of Add_Masked_MText

 (if(not lab:Size)(setq lab:Size(getvar "TEXTSIZE")))
 (setq oldSize lab:Size
lab:Size 
   (getreal 
     (strcat "\nText size <"(rtos lab:Size)">: ")))
 (if(null lab:Size)(setq lab:Size oldSize))
 (princ "\n<<< Select lines and curves to label >>> ")
 (if(setq lSet(ssget '((0 . "*LINE,ARC,ELLIPSE,CIRCLE"))))
   (progn
     (setq aDoc(vla-get-ActiveDocument(vlax-get-acad-object)))
     (vla-StartUndoMark aDoc)
     (foreach l(vl-remove-if 'listp(mapcar 'cadr(ssnamex lSet)))
(setq sPar(vlax-curve-getStartParam l)
	     ePar(vlax-curve-getEndParam l)
	     eLen(-(vlax-curve-getDistAtParam l ePar)
		      (vlax-curve-getDistAtParam l sPar))
             lPnt(vlax-curve-getPointAtDist l(/ eLen 2))
             iDr(vlax-curve-getFirstDeriv l
		  (vlax-curve-getParamAtPoint l lPnt))
	     iAng(- pi
		    (atan
		      (/(car iDr)
			(if(= 0.0(cadr iDr))(* 2 pi)(cadr iDr)))))
             cTxt(strcat(rtos eLen 2 0)"'")
             tWid(caadr
		   (textbox
		      (list(cons 1 cTxt)
			 (cons 40 lab:Size)(cons 41 0.)))
	     ); end setq
(Add_Masked_MText cTxt lPnt lab:Size (+ tWid(/ lab:Size 3)) 0.8 iAng 1.0)
); end foreach
       (vla-EndUndoMark aDoc)
     ); end progn
   (princ "\n<!> Nothing selected <!> ")
   ); end if 
 (princ)
 ); end of c:lmark
 

 

Length_Labler.jpg

 

can you please make this work for 2022 autocad ? thanks

 

Link to comment
Share on other sites
Red Cedar Rookie

Red Cedar

Posted
Posted
On 2/6/2011 at 4:05 AM, Smirnoff said:

I slightly modified your code :)

 

  

(defun c:lmark(/ aDoc cTxt eLen ePar iAng iDr lPnt lSet oldSize sPar tWid)
 
 (vl-load-com)

 (defun Add_Masked_MText(Str Pt Hei Wid wiF Ang Mask
		  / oOsn cLay cTxt actSp nTxt
		  oDxf nDxf mPt xPt aDoc aSp lFlg)

 ; (Add_Masked_MText <Str> <Pt> <Hei> <Wid> <wiF> <Ang> <Mask>)
 
 (setq oOsn(getvar "OSMODE")
aDoc(vla-get-ActiveDocument
		(vlax-get-acad-object))
cLay (vla-get-ActiveLayer aDoc)
aSp(vla-get-ActiveSpace aDoc)
   ); end setq
   (if(= 1 aSp)
     (setq aSp(vla-get-ModelSpace aDoc))
     (setq aSp(vla-get-PaperSpace aDoc))
     ); end if
    (if(= :vlax-true(vla-get-Lock cLay))
   (progn
     (vla-put-Lock cLay :vlax-false)
     (setq lFlg T)
   ); end progn
); end if
    (if(= 1.0 wiF)
 (setq cTxt(strcat "\\pxqc;" Str))
 (setq cTxt(strcat "\\pxqc;{\\W" (rtos wiF) ";" Str "}"))
); end if
       (setq nTxt(vla-AddMText aSp
	    (vlax-3D-point '(0.0 0.0 0.0)) 1.0 cTxt))
(vla-put-Height nTxt Hei)
(vla-put-Width nTxt(+ Wid(/ Hei 2)))
(vla-put-BackgroundFill nTxt -1)
(setq oDxf(entget(vlax-vla-object->ename nTxt))
      nDxf(subst (cons 45 Mask)(assoc 45 oDxf)oDxf)
       ); end setq
 (entmod nDxf)
 (vla-getBoundingBox nTxt 'mPt 'xPt)
 (setq mPt(vlax-safearray->list mPt)
       xPt(vlax-safearray->list xPt)
       mPt(vlax-3d-point
	      (list(+(car mPt)(/(-(car xPt)(car mPt))2))
		 (+(cadr mPt)(/(-(cadr xPt)(cadr mPt))2))
			 0.0))
		); end setq
         (vla-Move nTxt mPt(vlax-3D-point Pt))
  (if(and(> Ang 0)(<= Ang pi))
     (vla-Rotate nTxt(vlax-3D-point Pt)(- Ang(/ pi 2)))
     (vla-Rotate nTxt(vlax-3D-point Pt)(+ Ang(/ pi 2)))
   ); end if
    (if lFlg
       (vla-put-Lock cLay :vlax-true)
     ); end if
  nTxt
 ); end of Add_Masked_MText

 (if(not lab:Size)(setq lab:Size(getvar "TEXTSIZE")))
 (setq oldSize lab:Size
lab:Size 
   (getreal 
     (strcat "\nText size <"(rtos lab:Size)">: ")))
 (if(null lab:Size)(setq lab:Size oldSize))
 (princ "\n<<< Select lines and curves to label >>> ")
 (if(setq lSet(ssget '((0 . "*LINE,ARC,ELLIPSE,CIRCLE"))))
   (progn
     (setq aDoc(vla-get-ActiveDocument(vlax-get-acad-object)))
     (vla-StartUndoMark aDoc)
     (foreach l(vl-remove-if 'listp(mapcar 'cadr(ssnamex lSet)))
(setq sPar(vlax-curve-getStartParam l)
	     ePar(vlax-curve-getEndParam l)
	     eLen(-(vlax-curve-getDistAtParam l ePar)
		      (vlax-curve-getDistAtParam l sPar))
             lPnt(vlax-curve-getPointAtDist l(/ eLen 2))
             iDr(vlax-curve-getFirstDeriv l
		  (vlax-curve-getParamAtPoint l lPnt))
	     iAng(- pi
		    (atan
		      (/(car iDr)
			(if(= 0.0(cadr iDr))(* 2 pi)(cadr iDr)))))
             cTxt(strcat(rtos eLen 2 0)"'")
             tWid(caadr
		   (textbox
		      (list(cons 1 cTxt)
			 (cons 40 lab:Size)(cons 41 0.)))
	     ); end setq
(Add_Masked_MText cTxt lPnt lab:Size (+ tWid(/ lab:Size 3)) 0.8 iAng 1.0)
); end foreach
       (vla-EndUndoMark aDoc)
     ); end progn
   (princ "\n<!> Nothing selected <!> ")
   ); end if 
 (princ)
 ); end of c:lmark
 

 

Length_Labler.jpg

 

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.

×
 Share
Go to topic listing
×
×
  • Create New...