Jump to content

Help with code - Polyline with Text and circle on vertex

mhy3sx

By mhy3sx
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

mhy3sx Collaborator

mhy3sx

Posted
Posted

Hi I am writting this code but I have some problems. I want to select the polyline  ,then pick the start point and them ccw insert the circle and letter on vertex. The code insert the text  but don't start from the pick point

  

(defun c:foo1 ( / t_lst ent start_pt last_v e_pt s_pt cnt label )
 (setq t_lst (list "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "M" "N"))
  (setq ent (car (entsel "\nSelect Polyline to Label : ")))
  (if ent
      (progn
        (if (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
            (progn
              (setq start_pt (getpoint "\nPick the start point: "))
              (if start_pt
                  (progn
                    (setq last_v (vlax-curve-getendparam ent)
                          e_pt (vlax-curve-getendpoint ent)
                          s_pt (vlax-curve-getstartpoint ent)
                          cnt 0)

                    (if (equal e_pt s_pt 0.001)
                        (setq last_v (1- last_v)))

                    (while (<= cnt last_v)
                      (setq label (nth (rem cnt (length t_lst)) t_lst))

					  (entmakex	(list
													(cons 0 "TEXT")
													(cons 7 (getvar 'textstyle))
													;(cons 40 (getvar 'textsize))
												    (cons 40 0.40)
													(cons 10 (vlax-curve-getpointatparam ent cnt))
													(cons 1 (nth (fix cnt) t_lst))
												)
						)


                      (setq cnt (1+ cnt))
                      )
                    )
                )
              )
          )
        (princ)
        )
    (princ "\nNo valid polyline selected.")
    )
  (princ)
)

 

 

Then I have a second code . This code create circles on vertex of the polyline and I want to combine this code with the previous code !!!!!

  

(defun c:foo2 (/ ss rad)
(command "setvar" "clayer" "0")
(COMMAND "_layer" "_m" "PL" "_c" "140" "" "")
  (and (setq ss (ssget '((0 . "LWPOLYLINE"))))
       (setq rad 0.05)
       ((lambda (space)
          (vlax-for x (setq ss (vla-get-activeselectionset *AcadDoc*))
            ((lambda (n coords elev)
               (repeat (/ (length coords) 2)
                 (vla-AddCircle
                   space
                   (vlax-3D-point
                     (list (nth (setq n (1+ n)) coords) (nth (setq n (1+ n)) coords) elev)
                   )
                   rad
                 )
               )
             )
              -1
              (vlax-get x 'Coordinates)
              (vla-get-Elevation x)
            )
          )
          (vla-delete ss)
        )
         (if (or (eq acmodelspace
                     (vla-get-activespace
                       (cond (*AcadDoc*)
                             ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
                       )
                     )
                 )
                 (eq :vlax-true (vla-get-mspace *AcadDoc*))
             )
           (vla-get-modelspace *AcadDoc*)
           (vla-get-paperspace *AcadDoc*)
         )
       )
  )
(command "setvar" "clayer" "0")
  (princ)
)

 

 

Can any one help?  I upload a test.dwg for my template settings.

 

Thanks

test.dwg

Link to comment
Share on other sites
mhy3sx Collaborator

mhy3sx

Posted
  • Author
Posted

The code now works . Can any one make it better ?

  

(defun c:foo ( / t_lst ent start_pt last_v e_pt s_pt cnt label )
(command "setvar" "clayer" "0")
(command "_layer" "_m" "PL" "_c" "140" "" "")
 (setq t_lst (list "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "M" "N"))
 (c:CHIV)
	
  (cond ( (and 	(setq ent (car (entsel "\nSelect Polyline to Label : ")))
		        (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
		  )
		  (setq last_v (vlax-curve-getendparam ent)
			    cnt 0.0
		  )
		  (while (<= cnt last_v)
			(entmakex  (list
						    (cons 0 "TEXT")
							;(cons 7 (getvar 'textstyle))
							(cons 7 "TopoCAD")
							;(cons 40 (getvar 'textsize))
							(cons 40 0.40)
							(cons 10 (vlax-curve-getpointatparam ent cnt))
							(cons 1 (nth (fix cnt) t_lst))
						)
			)
			(setq cnt (1+ cnt))
		  )
		)
  )
  (c:foo2)	
  (princ)
(command "setvar" "clayer" "0")
)








; insert circles

(defun c:foo2 (/ ss rad)
  (and (setq ss (ssget '((0 . "LWPOLYLINE"))))
       (setq rad 0.05)
       ((lambda (space)
          (vlax-for x (setq ss (vla-get-activeselectionset *AcadDoc*))
            ((lambda (n coords elev)
               (repeat (/ (length coords) 2)
                 (vla-AddCircle
                   space
                   (vlax-3D-point
                     (list (nth (setq n (1+ n)) coords) (nth (setq n (1+ n)) coords) elev)
                   )
                   rad
                 )
               )
             )
              -1
              (vlax-get x 'Coordinates)
              (vla-get-Elevation x)
            )
          )
          (vla-delete ss)
        )
         (if (or (eq acmodelspace
                     (vla-get-activespace
                       (cond (*AcadDoc*)
                             ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
                       )
                     )
                 )
                 (eq :vlax-true (vla-get-mspace *AcadDoc*))
             )
           (vla-get-modelspace *AcadDoc*)
           (vla-get-paperspace *AcadDoc*)
         )
       )
  )
  (princ)
)

;Change polyline start point 

(defun c:CHIV ( / osm ss e f ed edd eddd eddd1 eddd2 eddd3 newed p m n i )

 (vl-load-com)

 (setq osm (getvar 'osmode))
 (setvar 'osmode 1)
 (prompt "\nPick closed 2d polyline with or without arcs")
 (setq ss (ssget "_+.:E:S:L" '((0 . "*POLYLINE") (-4 . "<or") (70 . 1) (70 . 129) (-4 . "or>"))))
 (if ss
   (setq e (ssname ss 0))
   (progn
     (setvar 'osmode osm)
     (alert "Picked wrong entity... Please pick normal closed 2d polyline next time-quitting...")
     (exit)
   )
 )
 (if (eq (cdr (assoc 0 (entget e))) "POLYLINE")
   (progn
     (setq f t)
     (command "_.convertpoly" "_l" e "")
   )
 )
 (setq ed (entget e))
 (setq edd nil)
 (foreach ec ed 
   (if (not 
         (or (eq (car ec) 10) (eq (car ec) 40) (eq (car ec) 41) (eq (car ec) 42) (eq (car ec) 91) (eq (car ec) 210))
       )
       (setq edd (cons ec edd))
   )
 )
 (setq edd (reverse edd))
 (setq eddd nil)
 (setq eddd1 nil)
 (setq eddd2 nil)
 (setq eddd (member (assoc 10 ed) ed))
 (setq p (getpoint "\nPick vertex you want to become initial"))
 (setq m (vlax-curve-getparamatpoint e (vlax-curve-getclosestpointto e p)))
 (if (assoc 91 ed) (setq n (* m 5)) (setq n (* m 4)))
 (setq i 0)
 (foreach ec eddd
   (progn
     (setq i (+ i 1))
     (if (<= i n)
       (setq eddd1 (cons ec eddd1))
     )
     (if (> i n)
       (setq eddd2 (cons ec eddd2))
     )
   )
 )
 (setq eddd1 (reverse eddd1))
 (setq eddd3 (list (assoc 210 eddd2)))
 (setq eddd2 (cdr eddd2))
 (setq eddd2 (reverse eddd2))
 (setq newed (append edd eddd2 eddd1 eddd3))
 (entmod newed)
 (entupd e)
 (setvar 'osmode osm)
 (if f
   (command "_.convertpoly" "_h" e "")
 )
 (princ)
)

 

Link to comment
Share on other sites
mhupp Veteran

mhupp

Posted
Posted (edited)
7 hours ago, mhy3sx said:

The code now works . Can any one make it better ?

  

(command "setvar" "clayer" "0")
(command "_layer" "_m" "PL" "_c" "140" "" "")
(setq t_lst (list "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "M" "N"))

(setvar 'clayer "0")
(entmake '((0 . "LAYER") (100 . "AcDbSymbolTableRecord") (100 . "AcDbLayerTableRecord") (2 . "PL") (70 . 0) (62 . 140)))
(setq t_lst '("A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "M" "N"))

 

 

 

This is what i have to make circles on LWPOLYLINE vertex

  

;;----------------------------------------------------------------------;;
;; ADD CIRCES TO VERTICY OF A POLYLINE.
(defun C:PCIRC (/ rad SS e ent coords)
  (setq rad (getreal "\nEnter Radius: "))
  (if (setq SS (ssget ":L" '((0 . "*POLYLINE")))) ;this allows you to select multiple at once instead one at a time
    (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      (setq cords (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))))
      (foreach pt cords
        (entmake (list '(0 . "CIRCLE") (cons 10 pt) (cons 40 rad)))
      )
    )
  )
  (princ)
)
Edited by mhupp
Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

Try this it rearranges the pline points based on the vertice you pick as the first, Note does not check CW or CCW. Should reduce code size.

  

(setq pt (getpoint "\npick corner "))
(setq plent (ssname (ssget pt) 0))
(setq corner (strcat (rtos (car pt) 2 6) (rtos (cadr pt) 2 6)))
(setq lstpts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget plent))))
(while (/= 
  (strcat (rtos (car (car lstpts)) 2 6) (rtos (cadr (car lstpts)) 2 6))
  corner)
  (setq lstpts (append (cdr lstpts) (list (car lstpts))))
)

 

Mhupp wants to select starting vertice then add Circle with text inside.

 

The attached like Mhupps Circle code will make a block with attribute. Use it as an example code not the code for your task pull what you want from it. Does A-Z or a number 1,2,3 and so on.

 

Pt num bubble.lsp

 

Multi GETVALS.lspMulti radio buttons.lsp

 

Edited by BIGAL
Link to comment
Share on other sites
mhy3sx Collaborator

mhy3sx

Posted
  • Author
Posted (edited) 
(defun c:foo (/ start_pt ss ent rad cords cnt label)
  (command "setvar" "clayer" "0")
  (command "_layer" "_m" "PL" "_c" "140" "" "")

  (setq start_pt (getpoint "\nPick corner: "))
  (setq ss (ssget start_pt))
  (setq ent (ssname ss 0))

  (setq cords (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))))
  (while (not (equal (mapcar 'cdr (assoc 10 (entget ent))) (mapcar 'cdr (car cords)))))
    (setq cords (append (cdr cords) (list (car cords))))
  
  
  (if (and ent (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE"))
      (progn
        (setq rad 0.05)
        (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
          (setq cords (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))))
          (foreach pt cords
            (entmake (list '(0 . "CIRCLE") (cons 10 pt) (cons 40 rad)))
          )
        )

        (setq cnt 0.0)
        (setq label 0)
        (while (<= cnt 1.0)
          (setq label (1+ label))
          (entmakex (list
                      '(0 . "TEXT")
                      (cons 7 "TopoCAD")
                      (cons 40 0.40)
                      (cons 10 (vlax-curve-getpointatparam ent cnt))
                      (cons 1 (char (+ 64 label)))
                    )
          )
          (setq cnt (+ cnt (/ 1.0 (float (1- (length cords))))))
        )
      )
  )

  (princ)
  (command "setvar" "clayer" "0")
)

 

Edited by mhy3sx
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...