Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Display Length of 3D Polyline

20 REPLIES 20
SOLVED
Reply
Message 1 of 21
DJPiper
2063 Views, 20 Replies

Display Length of 3D Polyline

Guys, Can you please help me on this, im looking for a lsp that can display the length (inserted text) measured from vertex 1 to any point that i click on a 3d polyline? Any help is highly appriciated. Thanks Guys!

 

 

20 REPLIES 20
Message 2 of 21
pbejse
in reply to: DJPiper


@DJPiper wrote:

Guys, Can you please help me on this, im looking for a lsp that can display the length (inserted text) measured from vertex 1 to any point that i click on a 3d polyline? Any help is highly appriciated. Thanks Guys!

 

 


(defun c:demo (/ pt obj)
  (if (and
	(setq pt (getpoint "\nPick any point on object"))
	(setq obj (Car (nentselp pt)))
	(eq "LWPOLYLINE" (cdr (assoc 0 (entget obj))))
      )
    (entmakex
      (list (cons 0 "TEXT")
	    (cons 10 pt)
	    (cons 40 1.0)
	    (cons 1
		  (rtos	(vlax-curve-getdistatpoint
			  obj
			  (vlax-curve-getClosestPointTo obj pt)
			)
			2
			2
		  )
	    )
      )
    )
  )
  (princ)
)

 

I think yu can do the rest on your own DJPiper

 

 HTH

Message 3 of 21
Kent1Cooper
in reply to: pbejse


@pbejse wrote:

@DJPiper wrote:

Guys, Can you please help me ... display the length (inserted text) measured from vertex 1 to any point that i click on a 3d polyline? .... 


....
	(eq "LWPOLYLINE" (cdr (assoc 0 (entget obj))))
....

....


For a 3D Polyline, you can't just use its (assoc 0) value, because they share the same one there with "heavy" 2D Polylines, i.e. (0 . "POLYLINE").  One way would be to replace the above with this:

        (member '(100 . "AcDb3dPolyline") (entget obj))

 

Another option is to leave out that entity-type check entirely, and it will work on 3DPolylines, but also Lightweight and heavy 2D ones, as well as Lines, Arcs, Circles, Ellipses, Splines....

 

Also, you can get whatever Text justification you want, if other than Left, with the right combination of 72 & 73 values, and with 11 instead of 10 for the insertion point.  [I believe you need to include a 10 value, even though that will be recalculated depending on the Text, but it can be just a placeholder like (10 0.0 0.0 0.0).]  A routine can also be made to align the Text with [or perpendicular to, if that serves your purpose] the direction of the object at that point.

 

 

Kent Cooper, AIA
Message 4 of 21
DJPiper
in reply to: pbejse

Thanks pbejse, The routine works with 2D polyline but not with 3D polyline.

Kent1Cooper was mentioning a fix to make it work with 3d polyline, but i dont know how to do it.

 

im an Autocad user for quite some time but didnt actually touch the LISP side of it. Zero knowledge on this part.

usually AutoCAD Plant 3D is my main tool to get my work done with facilities piping. Now im working with Pipeline, and Autocad is my only tool.

With this forum, the excellent lisp available on it, tips and tricks, and the very helpful members like you guys is a very huge help for me.

Thank you Guys!

 

 

 

Message 5 of 21
Kent1Cooper
in reply to: DJPiper


@DJPiper wrote:

Thanks pbejse, The routine works with 2D polyline but not with 3D polyline.

Kent1Cooper was mentioning a fix to make it work with 3d polyline, but i dont know how to do it.

..... 


You can either replace pbejse's entire line that starts with (eq with my line that starts with (member, which will restrict it to use on 3DPolylines only, or just let it work with many entity types [including 3DPolylines but not restricted to them] by simply eliminating the entire line that starts with (eq.

Kent Cooper, AIA
Message 6 of 21
DJPiper
in reply to: Kent1Cooper

Hi Kent

 

Thanks for the quick response, i had eleiminated that line which result to this.

 

(defun c:demo (/ pt obj)
  (if (and
    (setq pt (getpoint "\nPick any point on object"))
    (setq obj (Car (nentselp pt)))
      )
    (entmakex
      (list (cons 0 "TEXT")
        (cons 10 pt)
        (cons 40 1.0)
        (cons 1
          (rtos    (vlax-curve-getdistatpoint
              obj
              (vlax-curve-getClosestPointTo obj pt)
            )
            2
            2
          )
        )
      )
    )
  )
  (princ)
)

 

 

 

Its works on Line, Polyline, Arc, Spline Circle as you mentioned, but still not with 3D polyline.

i get an error saying...

                              bad argument value: AcDbCurve 62

                                                                                    63,64.......

Message 7 of 21
Kent1Cooper
in reply to: DJPiper

In a quick experiment, I find that what (car (nentselp)) returns is a Vertex object, not the 3DPolyline object itself.  [EDIT:  I didn't try it, but I would guess you'd have the same problem with a "heavy" 2D Polyline.]  The Vertex isn't in the "curve" class for (vlax-curve...) functions to work with, which is the source of the error message.  Here's a small adjustment using (entsel) instead, that gets the 3DPolyline and works in limited testing:

 

(defun c:demo (/ esel obj pt)
  (if
    (and
      (setq esel (entsel "\nPick any point on object"))
      (setq
        obj (car esel)
        pt (cadr esel)
      ); setq
    ); and
    (entmakex
      (list
        (cons 0 "TEXT")
        (cons 10 pt)
        (cons 40 1.0)
        (cons 1
          (rtos

            (vlax-curve-getdistatpoint
              obj
              (vlax-curve-getClosestPointTo obj pt)
            )
            2
            2
          )
        )
      )
    )
  )
  (princ)
)

 

However, I would make the further suggestion that you find the point actually on the 3DPolyline sooner, so that the insertion point of the Text will be at that location, rather than as the above does it, at the cursor location at the time of selection, which won't necessarily be on the 3DPolyline:

 

(defun c:demo (/ esel obj pt)
  (if
    (and
      (setq esel (entsel "\nPick any point on object"))
      (setq
        obj (car esel)
        pt (vlax-curve-getClosestPointTo obj (cadr esel))
      ); setq
    ); and
    (entmakex
      (list
        (cons 0 "TEXT")
        (cons 10 pt); now at really-on-it location
        (cons 40 1.0)
        (cons 1 (rtos (vlax-curve-getdistatpoint obj pt) 2 2))
      )
    )
  )
  (princ)
)

 

FURTHER EDIT:  It occurred to me that if the 3DPolyline is really 3D, and its segments may slope in the Z direction, when you pick it in plan view, the getClosestPointTo approach is going to go 3D-perpendicularly from the pick location to the nearest segment, and you'll get some different location than you picked as a result -- the steeper the slope or the farther from the current plane, the farther off.  I tried it and found that to be the case.  But I find Object-snapping to the Nearest point doesn't do that, but goes to the nearest place as seen in the current view direction:

 

(defun c:demo (/ esel obj pt)
  (if
    (and
      (setq esel (entsel "\nPick any point on object"))
      (setq
        obj (car esel)
        pt (osnap (cadr esel) "_nea")
      ); setq
    ); and
    (entmakex
      (list
        (cons 0 "TEXT")
        (cons 10 pt)
        (cons 40 1.0)
        (cons 1
          (rtos (vlax-curve-getdistatpoint obj pt) 2 2)
        )
      )
    )
  )
  (princ)
)

Kent Cooper, AIA
Message 8 of 21
DJPiper
in reply to: Kent1Cooper

Thank you So much KENT! and to you PBEJSE as well. The routine now works Perfectly. its works not only on 3D polyline but to other object as well. THANK YOU VERY MUCH GUYS!
Message 9 of 21
Kent1Cooper
in reply to: DJPiper


@DJPiper wrote:
Thank you So much KENT! and to you PBEJSE as well. The routine now works Perfectly. its works not only on 3D polyline but to other object as well. THANK YOU VERY MUCH GUYS!

You're welcome, but I couldn't take all the Accept-As-Solution credit for it, since I just tweaked pbejse's code.  So I have marked their original routine message also as [at least a part of] the Solution [we Expert Elites wield the awesome power to do that, even in threads we didn't initiate].

Kent Cooper, AIA
Message 10 of 21
Lee_Mac
in reply to: Kent1Cooper

How about using a Field - for example:

 

(defun c:3dl ( / ent obj )
    (while
        (progn (setvar 'errno 0) (setq ent (entsel))
            (cond
                (   (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                (   (null ent) nil)
                (   (not (vlax-property-available-p (setq obj (vlax-ename->vla-object (car ent))) 'length))
                    (princ "\nSelected object does not have a 'Length' property.")
                )
                (   (vla-addtext
                        (vlax-get-property (LM:acdoc)
                            (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)
                        )
                        (strcat
                            "%<\\AcObjProp Object(%<\\_ObjId "
                            (LM:objectid obj)
                            ">%).Length \\f \"%lu6\">%"
                        )
                        (vlax-3D-point
                            (vlax-curve-getclosestpointtoprojection (car ent)
                                (trans  (cadr ent) 1 0)
                                (trans '(0.0 0.0 1.0) 1 0 t)
                            )
                        )
                        1.0
                    )
                )
            )
        )
    )
    (princ)
)

;; ObjectID  -  Lee Mac
;; Returns a string containing the ObjectID of a supplied VLA-Object
;; Compatible with 32-bit & 64-bit systems
 
(defun LM:ObjectID ( obj )
    (eval
        (list 'defun 'LM:ObjectID '( obj )
            (if (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
                (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
               '(itoa (vla-get-objectid obj))
            )
        )
    )
    (LM:ObjectID obj)
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

(vl-load-com) (princ)

 

You could also use my Quick Field application to construct your own mini-program.

 

Kent1Cooper wrote:

FURTHER EDIT:  It occurred to me that if the 3DPolyline is really 3D, and its segments may slope in the Z direction, when you pick it in plan view, the getClosestPointTo approach is going to go 3D-perpendicularly from the pick location to the nearest segment, and you'll get some different location than you picked as a result -- the steeper the slope or the farther from the current plane, the farther off.  I tried it and found that to be the case.  But I find Object-snapping to the Nearest point doesn't do that, but goes to the nearest place as seen in the current view direction:

 

(defun c:demo (/ esel obj pt)
  (if
    (and
      (setq esel (entsel "\nPick any point on object"))
      (setq
        obj (car esel)
        pt (osnap (cadr esel) "_nea")
      ); setq
    ); and
    (entmakex
      (list
        (cons 0 "TEXT")
        (cons 10 pt)
        (cons 40 1.0)
        (cons 1
          (rtos (vlax-curve-getdistatpoint obj pt) 2 2)
        )
      )
    )
  )
  (princ)
)

 

Use the vlax-curve-getclosestpointtoprojection function.

 

Message 11 of 21
Kent1Cooper
in reply to: Lee_Mac


@Lee_Mac wrote:

How about using a Field - for example:

 

....
                (   (not (vlax-property-available-p (setq obj (vlax-ename->vla-object (car ent))) 'length))
                    (princ "\nSelected object does not have a 'Length' property.")
                )
....

....

.... the getClosestPointTo approach is going to go 3D-perpendicularly from the pick location to the nearest segment, and you'll get some different location than you picked ....  But I find Object-snapping to the Nearest point doesn't do that, but goes to the nearest place as seen in the current view direction....

 

Use the vlax-curve-getclosestpointtoprojection function.

 


On the Field approach, unless there's another way to do it that doesn't depend on the object's having a Length property, it will limit the User to Lines and Polylines [which does cover the OP's original question].  Circles, Arcs, Ellipses and Splines don't have a Length property, but the routine I posted works on those, for anyone who needs that.

I tried out the getClosestPointToProjection function in something else not long ago, and it didn't return what I expected.  I'll have to dig into that again to figure out where I was going wrong, or whether there was anything about the situation that would explain its not working as described, but its description sounds like it should do what's wanted.  But Osnap does, too, so....

 

[EDIT:  The ridiculous amount of empty space in that code window is not my doing.  It didn't look that way as I was working on it, and it doesn't while I've re-opened it to add this, but the bottom of the code window is right up against the last .... bit.  A quirk of the system, I guess.]

Kent Cooper, AIA
Message 12 of 21
Lee_Mac
in reply to: Kent1Cooper

Kent1Cooper wrote:

On the Field approach, unless there's another way to do it that doesn't depend on the object's having a Length property, it will limit the User to Lines and Polylines [which does cover the OP's original question].  Circles, Arcs, Ellipses and Splines don't have a Length property, but the routine I posted works on those, for anyone who needs that.

 

Circles & Arcs could be included using the Circumference & ArcLength properties respectively - but the OP requested a program for displaying the length of a 3D Polyline, so this is beside the point.

 

Kent1Cooper wrote:

But Osnap does, too, so....

 

The use of osnap is not entity-dependent and will also be affected by the view direction.

Message 13 of 21
DJPiper
in reply to: Lee_Mac

Guys, the routine works and it helps me a lot already.

but would it be possible to put the measured length inside an attribute block?

and also automatically populate X Y and Z coordinates?

 

i have attached a pix on what im trying to use, and a block which has a 6 attributes fields on it.

          1. TAG  = User Define (manual input)

          2. DESC = User Define (manual input)

          3. LENGTH = Measured length from vertex 1 to any point that has been picked (block inserted point)

          4. XCORD = X Coordinates with respect to WCS

          5. YCORD = Y Coordinates with respect to WCS

          6. ZCORD = Z Coordinates with respect to WCS

attributes 1 &2 are manually input by user and rest will be automatically populated.

 

Im not sure how difficult this one is, and hopefully im not asking too much.Smiley Embarassed

Thanks guys!

 

 

Message 14 of 21
Lee_Mac
in reply to: DJPiper

Try the following code:

 

(defun c:dislen ( / blk bln cmd ent ins ocs pos spc tag )

    (setq bln "pointer" ;; Block Name
          ocs (trans '(0.0 0.0 1.0) 1 0 t)
          spc
        (vlax-get-property (vla-get-activedocument (vlax-get-acad-object))
            (if (= 1 (getvar 'cvport))
                'paperspace
                'modelspace
            )
        )
    )
    (if
        (or (tblsearch "block" (setq blk bln))
            (and (setq blk (findfile (strcat bln ".dwg")))
                (progn
                    (setq cmd (getvar 'cmdecho))
                    (setvar 'cmdecho 0)
                    (command "_.-insert" blk nil)
                    (setvar 'cmdecho cmd)
                    (tblsearch "block" (setq blk bln))
                )
            )
        )
        (while (setq ins (getpoint "\nSpecify point <Exit>: "))
            (if
                (and
                    (setq ent (car (nentselp ins)))
                    (wcmatch (cdr (assoc 0 (entget ent))) "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE")
                )
                (foreach att
                    (vlax-invoke
                        (vla-insertblock spc
                            (vlax-3D-point (setq ins (vlax-curve-getclosestpointtoprojection ent (trans ins 1 0) ocs)))
                            blk 1.0 1.0 1.0
                            (LM:readable (+ (/ pi 2.0) (angle '(0.0 0.0) (trans (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent ins)) 0 ocs t))))
                        )
                        'getattributes
                    )
                    (cond
                        (   (= "LENGTH" (setq tag (strcase (vla-get-tagstring att))))
                            (vla-put-textstring att (rtos (vlax-curve-getdistatpoint ent ins)))
                        )
                        (   (setq pos (vl-position tag '("XCORD" "YCORD" "ZCORD")))
                            (vla-put-textstring att (nth pos (mapcar 'rtos ins)))
                        )
                    )
                )       
                (princ "\nNo valid object found at the selected point.")
            )
        )
        (princ (strcat "\nBlock \"" bln "\" not found."))
    )
    (princ)
)

;; Readable  -  Lee Mac
;; Returns an angle corrected for text readability.

(defun LM:readable ( a )
    (   (lambda ( a )
            (if (and (< (* pi 0.5) a) (<= a (* pi 1.5)))
                (LM:readable (+ a pi))
                a
            )
        )
        (rem (+ a pi pi) (+ pi pi))
    )
)
(vl-load-com) (princ)

 

Message 15 of 21
CADaSchtroumpf
in reply to: DJPiper

You can also try my version.

If block not exist, it's making!
The tag "TAG" is automaticly incremented...
Only tag "DESC" is as default.
All vertex are pointed without input user, the increment can be used in the order for all polylines selected

Message 16 of 21
DJPiper
in reply to: Lee_Mac

Hi Lee,

i have test the code and it perfectly works on a 2D polyline, Line, Arc and Spline.

but not on a 3D polyline. i got this error if i click on a 3d polyline

       "No valid object found at the selected point."

 

 

Message 17 of 21
DJPiper
in reply to: CADaSchtroumpf

Thanks for this one CADaStroumph. This is good. It gives all the length and coordiantes of all the vertex of the 3D polyline in one shot, i will have a used for this for sure, but right now im kinda looking on user specified point, not exactly on the vertex but also somewhere along the 3dpolyline. 

Thank you very much! smileyhappy:

 

 

Message 18 of 21
CADaSchtroumpf
in reply to: DJPiper

Glad to help you,

I quickly modified the code to respond at your convenience, try it!

(defun inc_txt (Txt / Boucle Decalage Val_Txt Ascii_Txt)
  (setq Boucle 1 Val_txt "")
  (while (<= Boucle (strlen Txt))
    (setq Ascii_Txt (vl-string-elt Txt (- (strlen Txt) Boucle)))
    (if (not Decalage)
      (setq Ascii_Txt (1+ Ascii_Txt))
    )
    (if (or (= Ascii_Txt 58) (= Ascii_Txt 91) (= Ascii_Txt 123))
      (setq
        Ascii_Txt
        (cond
          ((= Ascii_Txt 58) 48)
          ((= Ascii_Txt 91) 65)
          ((= Ascii_Txt 123) 97)
        )
        Decalage nil
      )
      (setq Decalage T)
    )
    (setq Val_Txt (strcat (chr Ascii_Txt) Val_Txt))
    (setq Boucle (1+ Boucle))
  )
  (if (not Decalage)
    (setq Val_Txt
      (strcat
        (cond
          ((< Ascii_Txt 58) "0")
          ((< Ascii_Txt 91) "A")
          ((< Ascii_Txt 123) "a")
        )
        Val_Txt
      )
    )
  )
  Val_Txt
)
(defun c:BlockAtt2Pt ( / js lst_posatt n nb_e ent dxf_ent dxf_210 vlaobj perim_obj n_ini n_next pt abs_curv nb nb_dec inc x y z d num ang pos_att)
  (cond
    ((eq (getvar "cvport") 1)
      (princ "\n** Command allowed only in the space object.")
    )
    (T
      (if (not (tblsearch "STYLE" "Arial"))
        (entmake
          '(
          (0 . "STYLE")
          (5 . "40")
          (100 . "AcDbSymbolTableRecord")
          (100 . "AcDbTextStyleTableRecord")
          (2 . "Arial")
          (70 . 0)
          (40 . 0.0)
          (41 . 1.0)
          (50 . 0.0)
          (71 . 0)
          (42 . 2.5)
          (3 . "arial.ttf")
          (4 . "")
          )
        )
      )
      (if (not (tblsearch "BLOCK" "Pointer"))
        (progn
          (entmake
            '((0 . "BLOCK") (2 . "Pointer") (70 . 2) (8 . "0") (62 . 256) (6 . "ByLayer") (370 . -2) (10 0.0 0.0 0.0))
          )
          (entmake
            '(
            (0 . "LWPOLYLINE")
            (100 . "AcDbEntity")
            (67 . 0)
            (410 . "Model")
            (8 . "0")
            (62 . 1)
            (100 . "AcDbPolyline")
            (90 . 7)
            (70 . 1)
            (43 . 0.5)
            (38 . 0.0)
            (39 . 0.0)
            (10 19.0 11.0)
            (40 . 0.5)
            (41 . 0.5)
            (42 . 0.0)
            (91 . 0)
            (10 19.0 8.0)
            (40 . 0.5)
            (41 . 0.5)
            (42 . 0.0)
            (91 . 0)
            (10 75.0 8.0)
            (40 . 0.5)
            (41 . 0.5)
            (42 . 0.0)
            (91 . 0)
            (10 75.0 -8.0)
            (40 . 0.5)
            (41 . 0.5)
            (42 . 0.0)
            (91 . 0)
            (10 19.0 -8.0)
            (40 . 0.5)
            (41 . 0.5)
            (42 . 0.0)
            (91 . 0)
            (10 19.0 -11.0)
            (40 . 0.5)
            (41 . 0.5)
            (42 . 0.0)
            (91 . 0)
            (10 0.0 0.0)
            (40 . 0.5)
            (41 . 0.5)
            (42 . 0.0)
            (91 . 0)
            (210 0.0 0.0 1.0)
            )
          )
          (entmake
            '(
            (0 . "LWPOLYLINE")
            (100 . "AcDbEntity")
            (67 . 0)
            (410 . "Model")
            (8 . "0")
            (62 . 1)
            (100 . "AcDbPolyline")
            (90 . 2)
            (70 . 0)
            (43 . 0.5)
            (38 . 0.0)
            (39 . 0.0)
            (10 41.0 8.0)
            (40 . 0.5)
            (41 . 0.5)
            (42 . 0.0)
            (91 . 0)
            (10 41.0 -8.0)
            (40 . 0.5)
            (41 . 0.5)
            (42 . 0.0)
            (91 . 0)
            (210 0.0 0.0 1.0)
            )
          )
          (entmake
            '(
            (0 . "LWPOLYLINE")
            (100 . "AcDbEntity")
            (67 . 0)
            (410 . "Model")
            (8 . "0")
            (62 . 1)
            (100 . "AcDbPolyline")
            (90 . 2)
            (70 . 0)
            (43 . 0.5)
            (38 . 0.0)
            (39 . 0.0)
            (10 46.0 8.0)
            (40 . 0.5)
            (41 . 0.5)
            (42 . 0.0)
            (91 . 0)
            (10 46.0 -8.0)
            (40 . 0.5)
            (41 . 0.5)
            (42 . 0.0)
            (91 . 0)
            (210 0.0 0.0 1.0)
            )
          )
          (entmake
            '(
            (0 . "TEXT")
            (100 . "AcDbEntity")
            (67 . 0)
            (410 . "Model")
            (8 . "0")
            (62 . 1)
            (100 . "AcDbText")
            (10 42.6909 5.0 0.0)
            (40 . 2.0)
            (1 . "L")
            (50 . 0.0)
            (41 . 1.0)
            (51 . 0.0)
            (7 . "Arial")
            (71 . 0)
            (72 . 0)
            (11 0.0 0.0 0.0)
            (210 0.0 0.0 1.0)
            (100 . "AcDbText")
            (73 . 0)
            )
          )
          (entmake
            '(
            (0 . "TEXT")
            (100 . "AcDbEntity")
            (67 . 0)
            (410 . "Model")
            (8 . "0")
            (62 . 1)
            (100 . "AcDbText")
            (10 42.6909 2.0 0.0)
            (40 . 2.0)
            (1 . "X")
            (50 . 0.0)
            (41 . 1.0)
            (51 . 0.0)
            (7 . "Arial")
            (71 . 0)
            (72 . 0)
            (11 0.0 0.0 0.0)
            (210 0.0 0.0 1.0)
            (100 . "AcDbText")
            (73 . 0)
            )
          )
          (entmake
            '(
            (0 . "TEXT")
            (100 . "AcDbEntity")
            (67 . 0)
            (410 . "Model")
            (8 . "0")
            (62 . 1)
            (100 . "AcDbText")
            (10 42.6909 -1.0 0.0)
            (40 . 2.0)
            (1 . "Y")
            (50 . 0.0)
            (41 . 1.0)
            (51 . 0.0)
            (7 . "Arial")
            (71 . 0)
            (72 . 0)
            (11 0.0 0.0 0.0)
            (210 0.0 0.0 1.0)
            (100 . "AcDbText")
            (73 . 0)
            )
          )
          (entmake
            '(
            (0 . "TEXT")
            (100 . "AcDbEntity")
            (67 . 0)
            (410 . "Model")
            (8 . "0")
            (62 . 1)
            (100 . "AcDbText")
            (10 42.6909 -4.0 0.0)
            (40 . 2.0)
            (1 . "Z")
            (50 . 0.0)
            (41 . 1.0)
            (51 . 0.0)
            (7 . "Arial")
            (71 . 0)
            (72 . 0)
            (11 0.0 0.0 0.0)
            (210 0.0 0.0 1.0)
            (100 . "AcDbText")
            (73 . 0)
            )
          )
          (entmake
            '(
            (0 . "TEXT")
            (100 . "AcDbEntity")
            (67 . 0)
            (410 . "Model")
            (8 . "0")
            (62 . 1)
            (100 . "AcDbText")
            (10 42.6909 -7.0 0.0)
            (40 . 2.0)
            (1 . "D")
            (50 . 0.0)
            (41 . 1.0)
            (51 . 0.0)
            (7 . "Arial")
            (71 . 0)
            (72 . 0)
            (11 0.0 0.0 0.0)
            (210 0.0 0.0 1.0)
            (100 . "AcDbText")
            (73 . 0)
            )
          )
          (entmake
            '(
            (0 . "ATTDEF")
            (100 . "AcDbEntity")
            (67 . 0)
            (410 . "Model")
            (8 . "0")
            (100 . "AcDbText")
            (10 53.0334 -4.0 0.0)
            (40 . 8.0)
            (1 . "-")
            (50 . 0.0)
            (41 . 0.65)
            (51 . 0.0)
            (7 . "Arial")
            (71 . 0)
            (72 . 1)
            (11 60.5 0.0 0.0)
            (210 0.0 0.0 1.0)
            (100 . "AcDbAttributeDefinition")
            (280 . 0)
            (3 . "Tag No")
            (2 . "TAG")
            (70 . 0)
            (73 . 0)
            (74 . 2)
            (280 . 1)
            )
          )
          (entmake
            '(
            (0 . "ATTDEF")
            (100 . "AcDbEntity")
            (67 . 0)
            (410 . "Model")
            (8 . "0")
            (100 . "AcDbText")
            (10 27.6671 5.0 0.0)
            (40 . 2.0)
            (1 . "-")
            (50 . 0.0)
            (41 . 1.0)
            (51 . 0.0)
            (7 . "Arial")
            (71 . 0)
            (72 . 2)
            (11 39.0 5.0 0.0)
            (210 0.0 0.0 1.0)
            (100 . "AcDbAttributeDefinition")
            (280 . 0)
            (3 . "Length")
            (2 . "LENGTH")
            (70 . 0)
            (73 . 0)
            (74 . 0)
            (280 . 1)
            )
          )
          (entmake
            '(
            (0 . "ATTDEF")
            (100 . "AcDbEntity")
            (67 . 0)
            (410 . "Model")
            (8 . "0")
            (100 . "AcDbText")
            (10 28.91 2.0 0.0)
            (40 . 2.0)
            (1 . "-")
            (50 . 0.0)
            (41 . 1.0)
            (51 . 0.0)
            (7 . "Arial")
            (71 . 0)
            (72 . 2)
            (11 39.0 2.0 0.0)
            (210 0.0 0.0 1.0)
            (100 . "AcDbAttributeDefinition")
            (280 . 0)
            (3 . "X Cooordinate")
            (2 . "XCORD")
            (70 . 0)
            (73 . 0)
            (74 . 0)
            (280 . 1)
            )
          )
          (entmake
            '(
            (0 . "ATTDEF")
            (100 . "AcDbEntity")
            (67 . 0)
            (410 . "Model")
            (8 . "0")
            (100 . "AcDbText")
            (10 28.91 -1.0 0.0)
            (40 . 2.0)
            (1 . "-")
            (50 . 0.0)
            (41 . 1.0)
            (51 . 0.0)
            (7 . "Arial")
            (71 . 0)
            (72 . 2)
            (11 39.0 -1.0 0.0)
            (210 0.0 0.0 1.0)
            (100 . "AcDbAttributeDefinition")
            (280 . 0)
            (3 . "Y Cooordinate")
            (2 . "YCORD")
            (70 . 0)
            (73 . 0)
            (74 . 0)
            (280 . 1)
            )
          )
          (entmake
            '(
            (0 . "ATTDEF")
            (100 . "AcDbEntity")
            (67 . 0)
            (410 . "Model")
            (8 . "0")
            (100 . "AcDbText")
            (10 29.0668 -4.0 0.0)
            (40 . 2.0)
            (1 . "-")
            (50 . 0.0)
            (41 . 1.0)
            (51 . 0.0)
            (7 . "Arial")
            (71 . 0)
            (72 . 2)
            (11 39.0 -4.0 0.0)
            (210 0.0 0.0 1.0)
            (100 . "AcDbAttributeDefinition")
            (280 . 0)
            (3 . "ZCooordinate")
            (2 . "ZCORD")
            (70 . 0)
            (73 . 0)
            (74 . 0)
            (280 . 1)
            )
          )
          (entmake
            '(
            (0 . "ATTDEF")
            (100 . "AcDbEntity")
            (67 . 0)
            (410 . "Model")
            (8 . "0")
            (100 . "AcDbText")
            (10 31.2374 -7.0 0.0)
            (40 . 2.0)
            (1 . "-")
            (50 . 0.0)
            (41 . 1.0)
            (51 . 0.0)
            (7 . "Arial")
            (71 . 0)
            (72 . 2)
            (11 39.0 -7.0 0.0)
            (210 0.0 0.0 1.0)
            (100 . "AcDbAttributeDefinition")
            (280 . 0)
            (3 . "Description")
            (2 . "DESC")
            (70 . 0)
            (73 . 0)
            (74 . 0)
            (280 . 1)
            )
          )
          (entmake '((0 . "ENDBLK") (8 . "0") (62 . 256) (6 . "ByLayer") (370 . -2)))
        )
      )
      (princ "\nSelect Polylines where put a block with attributs at select point")
      (setq js (ssget '((0 . "*POLYLINE") (-4 . "<NOT") (-4 . "&") (70 . 112) (-4 . "NOT>"))))
      (cond
        (js
          (setq lst_posatt '((60.5 0.0 0.0) (39.0 5.0 0.0) (39.0 2.0 0.0) (39.0 -1.0 0.0) (39.0 -4.0 0.0) (39.0 -7.0 0.0)))
          (repeat (setq n (sslength js))
            (setq dxf_ent (entget (setq ent (ssname js (setq n (1- n))))) dxf_210 (cdr (assoc 210 dxf_ent)))
            (redraw ent 3)
            (setq
              vlaobj (vlax-ename->vla-object ent)
              perim_obj (vlax-curve-getDistAtParam vlaobj (vlax-curve-getEndParam vlaobj))
              nb_e 0
            )
            (if (not n_next)
              (setq
                n_ini (getstring "\nIncrement by starting in (number,letter or alphanumeric): ")
                n_next (if (eq n_ini "") "0" n_ini)
              )
              (progn
                (initget "Yes No")
                (if (eq (getkword "\nRe-initialize increment [Yes/No] <No>: ") "Yes")
                  (setq
                    n_ini (getstring "\nIncrement by starting in (number,letter or alphanumeric): ")
                    n_next (if (eq n_ini "") "0" n_ini)
                  )
                  (setq n_ini n_next)
                )
              )
            )
            (while (setq pto (getpoint "\nGive a point: "))
              (setq pto (vlax-curve-getClosestPointTo vlaobj (trans pto 1 0)))
              (cond
                (pto
                  (setq
                    abs_curv (vlax-curve-getDistAtPoint vlaobj pto)
                    n_ini n_next
                    x (car pto)
                    y (cadr pto)
                    z (caddr pto)
                    d abs_curv
                    num n_next
                    ang (+ (* 0.5 pi) (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv vlaobj (vlax-curve-getParamAtPoint vlaobj pto))))
                    pos_att (mapcar '(lambda (x) (polar (trans '(0.0 0.0 0.0) dxf_210 0) (+ (angle (trans '(0.0 0.0 0.0) dxf_210 0) (trans x dxf_210 0)) ang) (distance (trans '(0.0 0.0 0.0) dxf_210 0) (trans x dxf_210 0)))) lst_posatt)
                  )
                  (cond
                    ((eq (type (read n_ini)) 'INT)
                      (setq n_next (itoa (1+ (atoi n_ini))))
                    )
                    ((eq (type (read n_ini)) 'REAL)
                      (setq nb 0)
                      (repeat (strlen n_ini)
                        (if (eq (substr n_ini (setq nb (1+ nb)) 1) ".")
                          (setq nb_dec (1- (strlen (substr n_ini nb))))
                        )
                      )
                      (setq inc 1.0)
                      (repeat nb_dec (setq inc (/ inc 10)))
                      (setq n_next (rtos (+ inc (atof n_ini)) 2 nb_dec))
                    )
                    ((eq (type n_ini) 'STR)
                      (setq n_next (inc_txt n_ini))
                    )
                  )
                  (entmake
                    (append
                      '(
                      (0 . "INSERT")
                      (100 . "AcDbEntity")
                      (67 . 0)
                      (410 . "Model")
                      (100 . "AcDbBlockReference")
                      (66 . 1)
                      (2 . "Pointer")
                      (41 . 1.0)
                      (42 . 1.0)
                      (43 . 1.0)
                      (70 . 0)
                      (71 . 0)
                      (44 . 0.0)
                      (45 . 0.0)
                      )
                      (list (cons 50 ang) (cons 10 (trans pto 0 dxf_210)) (cons 210 dxf_210))
                    )
                  )
                  (entmake
                    (append
                      '(
                      (0 . "ATTRIB")
                      (100 . "AcDbEntity")
                      (67 . 0)
                      (410 . "Model")
                      (100 . "AcDbText")
                      )
                      (list
                        (cons 50 ang)
                        (cons 10 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
                        (cons 1 num)
                      )
                      '(
                      (40 . 8.0)
                      (41 . 0.65)
                      (51 . 0.0)
                      (7 . "Arial")
                      (71 . 0)
                      (72 . 1)
                      )
                      (list
                        (cons 11 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
                        (cons 210 dxf_210)
                      )
                      '(
                      (100 . "AcDbAttribute")
                      (2 . "TAG")
                      (70 . 0)
                      (73 . 0)
                      (74 . 2)
                      )
                    )
                  )
                  (setq pos_att (cdr pos_att))
                  (entmake
                    (append
                      '(
                      (0 . "ATTRIB")
                      (100 . "AcDbEntity")
                      (67 . 0)
                      (410 . "Model")
                      (100 . "AcDbText")
                      )
                      (list
                        (cons 50 ang)
                        (cons 10 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
                        (cons 1 (rtos d 2 4))
                      )
                      '(
                      (40 . 1.0)
                      (41 . 1.0)
                      (51 . 0.0)
                      (7 . "Arial")
                      (71 . 0)
                      (72 . 2)
                      )
                      (list
                        (cons 11 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
                        (cons 210 dxf_210)
                      )
                      '(
                      (100 . "AcDbAttribute")
                      (2 . "LENGTH")
                      (70 . 0)
                      (73 . 0)
                      (74 . 0)
                      )
                    )
                  )
                  (setq pos_att (cdr pos_att))
                  (entmake
                    (append
                      '(
                      (0 . "ATTRIB")
                      (100 . "AcDbEntity")
                      (67 . 0)
                      (410 . "Model")
                      (100 . "AcDbText")
                      )
                      (list
                        (cons 50 ang)
                        (cons 10 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
                        (cons 1 (rtos x 2 4))
                      )
                      '(
                      (40 . 1.0)
                      (41 . 1.0)
                      (51 . 0.0)
                      (7 . "Arial")
                      (71 . 0)
                      (72 . 2)
                      )
                      (list
                        (cons 11 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
                        (cons 210 dxf_210)
                      )
                      '(
                      (100 . "AcDbAttribute")
                      (2 . "XCORD")
                      (70 . 0)
                      (73 . 0)
                      (74 . 0)
                      )
                    )
                  )
                  (setq pos_att (cdr pos_att))
                  (entmake
                    (append
                      '(
                      (0 . "ATTRIB")
                      (100 . "AcDbEntity")
                      (67 . 0)
                      (410 . "Model")
                      (100 . "AcDbText")
                      )
                      (list
                        (cons 50 ang)
                        (cons 10 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
                        (cons 1 (rtos y 2 4))
                      )
                      '(
                      (40 . 1.0)
                      (41 . 1.0)
                      (51 . 0.0)
                      (7 . "Arial")
                      (71 . 0)
                      (72 . 2)
                      (11 0.0 0.0 0.0)
                      )
                      (list
                        (cons 11 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
                        (cons 210 dxf_210)
                      )
                      '(
                      (100 . "AcDbAttribute")
                      (2 . "YCORD")
                      (70 . 0)
                      (73 . 0)
                      (74 . 0)
                      )
                    )
                  )
                  (setq pos_att (cdr pos_att))
                  (entmake
                    (append
                      '(
                      (0 . "ATTRIB")
                      (100 . "AcDbEntity")
                      (67 . 0)
                      (410 . "Model")
                      (100 . "AcDbText")
                      )
                      (list
                        (cons 50 ang)
                        (cons 10 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
                        (cons 1 (rtos z 2 4))
                      )
                      '(
                      (40 . 1.0)
                      (41 . 1.0)
                      (51 . 0.0)
                      (7 . "Arial")
                      (71 . 0)
                      (72 . 2)
                      )
                      (list
                        (cons 11 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
                        (cons 210 dxf_210)
                      )
                      '(
                      (100 . "AcDbAttribute")
                      (2 . "ZCORD")
                      (70 . 0)
                      (73 . 0)
                      (74 . 0)
                      )
                    )
                  )
                  (setq pos_att (cdr pos_att))
                  (entmake
                    (append
                      '(
                      (0 . "ATTRIB")
                      (100 . "AcDbEntity")
                      (67 . 0)
                      (410 . "Model")
                      (100 . "AcDbText")
                      )
                      (list (cons 50 ang) (cons 10 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210)))
                      '(
                      (1 . "EXISTING")
                      (40 . 1.0)
                      (41 . 1.0)
                      (51 . 0.0)
                      (7 . "Arial")
                      (71 . 0)
                      (72 . 2)
                      )
                      (list
                        (cons 11 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
                        (cons 210 dxf_210)
                      )
                      '(
                      (100 . "AcDbAttribute")
                      (2 . "DESC")
                      (70 . 0)
                      (73 . 0)
                      (74 . 0)
                      )
                    )
                  )
                  (entmake '((0 . "SEQEND") (62 . 256) (6 . "ByLayer") (370 . -2)))
                  (setq nb_e (1+ nb_e))
                )
              )
            )
            (redraw ent 4)
            (princ (strcat "\n" (itoa nb_e) " blocks \"Pointer\" put and informed."))
          )
        )
        (T (princ "\nEmpty or not valid selection."))
      )
    )
  )
  (prin1)
)

 

Message 19 of 21
DJPiper
in reply to: CADaSchtroumpf

Wow CADaStroump! This is really good. perfectly works on a 3D polyline. and the TAG Field is incrementing automatically as the block insert, more than what i asked for. THANK YOU THANK YOU VERY MUCH!

 

one last request though, i guess the code is creating the block also. is it possible instead of creating the block inside the code,

the code will look for the dwg somehere on the supported ACAD Search path? This way, the block appearance will be changeable.

 

i was trying to change from the code but its a rocket science for me.

Thanks!

Message 20 of 21
CADaSchtroumpf
in reply to: DJPiper

one last request though, i guess the code is creating the block also. is it possible instead of creating the block inside the code,

the code will look for the dwg somehere on the supported ACAD Search path? This way, the block appearance will be changeable.

 

It would be for a block without attribute, this resolution would be possible, code would not definitely would been complicated, simple even much more than that offered.


But with a block with attribute it becomes more complicated because it becomes impossible to know the nature of attributes, in the order of these and of the manner of giving information to them.


If you want to change the definition of the block in code for other one you can use this, it is that I made with your block 'Pointer ' what I have expolde and applied the lisp in constituent entity.

 

(defun c:list_for_entmake ( / dxf_cod lremov)
	(setq dxf_cod (entget (car (entsel))) lremov nil)
	(foreach n dxf_cod (if (member (car n) '(5 330 -1)) (setq lremov (cons (car n) lremov))))
	(foreach m lremov
		(setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod))
	)
	(foreach n dxf_cod
		(print n)
	)
	(prin1)
)

 I make so a copy-paste of result in code.

To think of adapting the list "lst_posatt" for distribution of position of all attributes (origin to insertion point of attribute)

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost