+ Reply to Thread
Results 1 to 7 of 7
  1. #1
    Full Member dilan's Avatar
    Discipline
    Civil
    Using
    Civil 3D 2017
    Join Date
    Jan 2018
    Location
    From North
    Posts
    30

    Default Route 3d polyline. The beginning and the end of this 3d polyline.

    Registered forum members do not see this ad.

    Hey.
    In my program, I make the choice of 3d polylines using the function entsel:
    Code:
    (defun get-entsel-no-error (message / ent)
    (setvar "errno" 0)
      (while
        (and
          (not (setq ent (entsel (strcat "\n" message)))
          ) ;_ end of not
          (equal 7 (getvar "errno"))
          ) ;_ end of and
         (setvar "errno" 0)
      ) ;_ end of while
      (cond
        ((equal (getvar "errno") 52)
        nil
         )
        (t
         (list (car ent) (trans (cadr ent) 1 0))
        ))
      )
    Is it possible to do so after selecting a 3d polyline somehow showed the route of this 3d polyline, where the beginning and where the end. To the user after selecting the 3d polyline, understand where its beginning.
    Well, then he made some further actions .... laid down in the program.

  2. #2
    Quantum Mechanic BIGAL's Avatar
    Using
    Civil 3D 2016
    Join Date
    Dec 2005
    Location
    GEELONG AUSTRALIA
    Posts
    10,577

    Default

    Your asking for a direction you could use a simple block arrow say placed 1/2 way along the pline.
    Try this as a start a text V for arrow

    Code:
    (defun c:test ( / obj stpt endpt len pt ang )
    (setq oldsnap (getvar 'osmode))
    (setq angdirold (getvar 'angdir))
    (setq aunitsold (getvar 'aunits))
    (setq obj (vlax-ename->vla-object (car (entsel "pick object"))))
    (setq stpt (vlax-curve-getstartpoint obj))
    (setq endpt (vlax-curve-getendpoint obj))
    (setq len (/(vla-get-length obj) 2.0))
    (setq pt (vlax-curve-getpointatdist obj len))
    (setq ang (+(alg-ang obj pt) (/ pi 2)))
    (setvar 'osmode 0)
    (setvar 'angdir 0)
    (setvar 'aunits 3)
    (command "text" "J" "mc" pt 2.5 ang "V")
    (setvar 'osmode oldsnap)
    (setvar 'angdir angdirold)
    (setvar 'aunits aunitsold)
    )
    Last edited by BIGAL; 7th Jun 2018 at 09:56 am.
    A man who never made mistakes never made anything

  3. #3
    Senior Member
    Discipline
    Surveying
    dlanorh's Discipline Details
    Occupation
    Geospatial Engineer
    Discipline
    Surveying
    Using
    AutoCAD 2012
    Join Date
    Aug 2017
    Location
    UK/Bundesrepublik Deutschland
    Posts
    103

    Default

    You could also mark the ends with points. You would have to set a visible pdmode, i use 3.

    The following function would then put a green point on the start and a red one on the end.

    The function needs to be passed the polyline as an object, and returns a list of the two object names as a list.

    Code:
    (defun mark_ends ( obj / s_obj e_obj rtn)
      (setq ms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
            s_obj (vla-addpoint ms (vlax-3d-point (vlax-curve-getstartpoint obj)))
            e_obj (vla-addpoint ms (vlax-3d-point (vlax-curve-getendpoint obj)))
      )
      (vlax-put-property s_obj 'color 3)
      (vlax-put-property e_obj 'color 1)
      (setq rtn (list s_obj e_obj))      
    )
    to delete the two points when no longer needed

    Code:
    (foreach x_obj lst
      (vla-delete x_obj)
     )

    To invoke


    Code:
    (setq lst (mark_ends pl_obj))

  4. #4
    Super Member hanhphuc's Avatar
    Using
    AutoCAD 2007
    Join Date
    Apr 2013
    Location
    Happy Garden
    Posts
    707

    Default

    Quote Originally Posted by dilan View Post
    Hey.
    In my program, I make the choice of 3d polylines using the function entsel:
    Code:
    (defun get-entsel-no-error (message / ent)
    ...
    Is it possible to do so after selecting a 3d polyline somehow showed the route of this 3d polyline, where the beginning and where the end. To the user after selecting the 3d polyline, understand where its beginning.
    Well, then he made some further actions .... laid down in the program.
    hi, suggestion - transient object
    example: LM:GRTEXT

    or my old utility , little tweaks
    Code:
      (defun pointer:marker	(pt co / vs)
        (grvecs
          (apply 'append
    	     (mapcar ''((x)
    			(list
    			 co
    			 pt
    			 (polar pt (* pi x) (* 50. (setq vs (/ (getvar "viewsize") (cadr (getvar "screensize"))))))
    			 )
    			)
    		     '(0.0 0.5 1.0 1.5)
    		     )
    	     )
          )
        vs
        )
      
    
    (defun hp:pointer ( pt c en / enx p tp l ip vs a ang sz d ep ) ; v1.2
      
      (setq enx (entget en))
      (while (and (= (setq p (car (setq tp (grread t 13 0)))) 5) (setq l (cadr tp)))
        (redraw)
        (setq vs  (pointer:marker pt 6)
    	  ip  (osnap l "_nea")
    	  ip  (if ip
    		ip
    		l
    		)
    	  a   (angle pt ip)
    	  sz  (* 50. vs)
    	  ang (* pi 0.25)
    	  d   (* sz 0.25)
    	  ep  (polar ip (+ a pi) 0.)
    	  )
        
        (grvecs
          (apply 'append
    	     (mapcar ''((x) (list c ep x))
    		     (cons (polar ip a sz) (mapcar ''((f)(polar ep (f a ang) d))(list + -)))
    		     )
    	     )
          )
        (if	en
          (entmod (subst (cons 10 (trans (polar pt (angle pt ip) (+ (distance pt ip) 0.2 sz)) 1 0))
    		     (assoc 10 enx)
    		     enx
    		     )
    	      )
          )
        ) ;_ end of while
      ip
      )
    
    
    (defun msg:pointer (pts c msg / msg:MTEXT p tp l ip vs obj a sz ang d ep)
    
    (defun msg:MTEXT (str pt sz)
      (entmakex (mapcar 'cons
    		   '(0 100 100 1 10 40 50 7 8 71 72)
    		   (list "MTEXT" "AcDbEntity" "AcDbMText"
    			 (strcat "{\\fComplex|b0|i0|c0|p34;" str "}") ;<-- Ref: CAB's Strip_Text.lsp CopyRight© 2005-2007
    			 pt sz 0.0 (getvar "textstyle")
    			 "msg_Text" 5 5
    			 ) 
    		   ) 
    	   ) 
      ) ;_ end of defun
    
    
      
     (setq obj (vlax-ename->vla-object
    	     (msg:MTEXT msg '(0. 0. 0.) 1.0 )
    	     )
           pt (cond ((car pts))((getvar "viewctr"))))
      
    (while (and (= (setq p (car (setq tp (grread t 13 0)))) 5) (setq l (cadr tp)))
        (redraw)
    
      (setq vs  (pointer:marker pt c)
            ip  (osnap l "_nea")
    	ip  (if	ip
    	      ip
    	      l
    	      ) 
    	a   (angle pt ip)
    	sz  (* 100. vs)
    	ang (* pi 0.25)
    	d   (* sz 0.25)
    	ep  (polar ip (+ a pi) 0.) 
    	) 
      
      (foreach x pts
        (pointer:marker x c))
      
       (grvecs
         (apply 'append
    	    (mapcar '(lambda(x) (list c ep x))
    		    (cons (polar ip a sz) (mapcar '(lambda(f)(polar ep (f a ang) d))(list + -)))
    		    ) 
    	    ) 
         )
    
        
      (if obj
        
        (mapcar '(lambda( a b) (vlax-put obj a b ))
    	    '( "color" "InsertionPoint" "Height" )
    	     (list c (trans(polar pt (angle pt ip) (+(distance pt ip) 0.5 sz))1 0) (* 15. vs)))
    
        )
      
        ) ;_ end of while
           
      (if obj (vla-delete obj))
      
      (redraw)
      
      ip
      
      )
    test with your routine
    Code:
    (defun c:test (/ tx e en )
    
      (if (and (setq e (get-entsel-no-error "\nPick a polyline "))
    	   (setq en (car e))
    	   (wcmatch (cdr (assoc 0 (entget en))) "*LINE,ARC")
    	   )
        (progn (setq tx (entmakex '((0 . "TEXT") (1 . "START POINT") (10 0. 0. 0.) (62 . 3) (40 . 5))))
    	   (hp:pointer (trans (vlax-curve-getstartpoint en) 0 1) 2 tx)
    	   (if tx
    	     (entdel tx)
    	     )
    	   (pointer:marker (trans (vlax-curve-getendpoint en) 0 1) 5 )
    	   )
        (princ "\nOops! Please retry.. ")
        )
      (princ)
      ) ;_ end of defun
    Last edited by hanhphuc; 8th Jun 2018 at 01:26 am. Reason: add LM:GRTEXT link, add code - msg:pointer
    _$ ( apply 'equal "hp" "happy" "hạnh phúc" "ハッピー" "幸福" "행복" )
    ; error: too many arguments

  5. #5
    Full Member dilan's Avatar
    Discipline
    Civil
    Using
    Civil 3D 2017
    Join Date
    Jan 2018
    Location
    From North
    Posts
    30

    Default

    Thanks a lot guys for the ideas.

  6. #6
    Super Member hanhphuc's Avatar
    Using
    AutoCAD 2007
    Join Date
    Apr 2013
    Location
    Happy Garden
    Posts
    707

    Default

    another msg:pointer - updated at post#4
    display both points

    Code:
    (defun c:test2 (/ en pts )
      (if (and (setq en (get-entsel-no-error "\nPick a polyline "))
    	   (setq en (car en))
    	   (wcmatch (cdr (assoc 0 (entget en))) "*LINE,ARC")
    	   )
        (progn 
    	   (setq pts (mapcar ''((x) (trans ((eval (read (strcat "vlax-curve-get"x))) en) 0 1) ) '("StartPoint" "EndPoint")))
               (msg:pointer  pts AcGreen "START POINT") ; ACI color = 3
                (mapcar ''((a b) (pointer:marker a b)) pts '(6 5)) ; <-- you can change color index here 
    	   )
        (princ "\nOops! Please retry.. ")
        )
      (princ)
      ) ;_ end of defun
    Last edited by hanhphuc; 8th Jun 2018 at 01:28 am.
    _$ ( apply 'equal "hp" "happy" "hạnh phúc" "ハッピー" "幸福" "행복" )
    ; error: too many arguments

  7. #7
    Full Member dilan's Avatar
    Discipline
    Civil
    Using
    Civil 3D 2017
    Join Date
    Jan 2018
    Location
    From North
    Posts
    30

    Default

    Registered forum members do not see this ad.

    Quote Originally Posted by hanhphuc View Post
    another msg:pointer - updated at post#4
    display both points

    Code:
    (defun c:test2 (/ en pts )
      (if (and (setq en (get-entsel-no-error "\nPick a polyline "))
    	   (setq en (car en))
    	   (wcmatch (cdr (assoc 0 (entget en))) "*LINE,ARC")
    	   )
        (progn 
    	   (setq pts (mapcar ''((x) (trans ((eval (read (strcat "vlax-curve-get"x))) en) 0 1) ) '("StartPoint" "EndPoint")))
               (msg:pointer  pts AcGreen "START POINT") ; ACI color = 3
                (mapcar ''((a b) (pointer:marker a b)) pts '(6 5)) ; <-- you can change color index here 
    	   )
        (princ "\nOops! Please retry.. ")
        )
      (princ)
      ) ;_ end of defun
    Thank you.
    Your option suited me. I realized what I wanted.

Similar Threads

  1. Replies: 9
    Last Post: 2nd May 2017, 06:18 pm
  2. Selection Set for Elements Inside Polyline (including Polyline)
    By bigd632 in forum AutoLISP, Visual LISP & DCL
    Replies: 5
    Last Post: 24th Feb 2015, 07:47 pm
  3. Replies: 24
    Last Post: 15th Mar 2013, 11:12 am
  4. Snap Polyline to the block insertion without changing the orientation of Polyline
    By Dhuliya_jay in forum AutoLISP, Visual LISP & DCL
    Replies: 1
    Last Post: 9th Oct 2011, 09:49 am
  5. lisp to move largest room polyline to another layer for floor gross polyline
    By TheresaT in forum AutoLISP, Visual LISP & DCL
    Replies: 6
    Last Post: 25th Aug 2010, 07:11 pm

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts