Need Survey Stringing Lisp as soon as possible, Please

July 18, 2013

I have completed the code just a little bit with the filter of blocks so it won't return any errors!

(defun c:imli (/)
 (setq ss (ssget "_X" [color="red"](list '(0 . "INSERT")'(66 . 1)'(2 . "Point")(cons 410 (getvar 'Ctab)))[/color]))
 (setq pli (ssnamex ss))
 (setq li (list))
 (foreach a pli
   (setq li
   (append li
	   (list (cadr a))
   )
   )
 )
 (setq ali (list))
 (foreach o li
   (setq ali
   (append ali
	   (list (entnext o))
   )
   )
 )
 (setq oli (list))
 (foreach ob ali
   (setq oli
   (append oli
	   (list (cdr (assoc 1 (entget ob))))
   )
   )
 )
 (setq cli (list))
 (foreach c li
   (setq cli
   (append cli
	   (list (cdr (assoc 10 (entget c))))
   )
   )
 )
 (setq cnt 0)
 (setq fli (list))
 (while (/= cnt (length cli))
   (setq fli
   (append fli
	   (list (cons (nth cnt oli) (nth cnt cli)))
   )
   )
   (setq cnt (1+ cnt))
 )
 (setq slist (getstring t "\nEnter imovable limit point numbers: "))
 (setq lst (list))
 (while (setq pt (vl-string-search " " slist))
   (setq lst (cons (substr slist 1 pt) lst))
   (setq slist (substr slist (+ pt 2)))
 )
 (setq lst (reverse (cons slist lst)))
 (setq	als (list)
cnt 0
 )
 (while (/= cnt (length lst))
   (foreach a fli
     (setq als
     (append als
	     (if (= (nth cnt lst) (car a))
	       (list (cons 10 (cdr a)))
	     )
     )
     )
   )
   (setq cnt (1+ cnt))
 )
 (setq vn (length als))
 (setq	adl    (list '(0 . "LWPOLYLINE")
	     '(100 . "AcDbEntity")
	     '(100 . "AcDbPolyline")
	     (cons 90 vn)
	     '(70 . 1)
       )
adf    (list '(210 0.0 0.0 1.0))
enlist (append adl als)
enlist (append enlist adf)
 )
 (entmake enlist)
 (princ)
)

(princ)

July 18, 2013

ok now imli.lsp works fine like lineat.lsp .

1. Can you make a choose to use line or polyline

2.I need to see the line or polyline from point to point and not all at the end (to avoid mistakes)

July 18, 2013

1. Can you make a choose to use line or polyline

2.I need to see the line or polyline from point to point and not all at the end (to avoid mistakes)

I have a feeling that those two items wont be the end of it prodromosm, Relax and take a deep breath and think hard, what else do i need to add.

July 18, 2013

That two items will be the end i promise

July 18, 2013

Try this now and let me know .

(vl-load-com)
(defun c:Test (/ *error* ss i l i sn nx l f fl id e lst grp p v pt)
;;; Author : Tharwat Al SHoufi     ;;;
 (defun *error* (x)
   (if (and f (setq f (findfile f)))
     (vl-file-delete f)
   )
   (princ "\*Cancel*")
 )
 (if (setq ss (ssget "_X"
                     (list '(0 . "INSERT")
                           '(66 . 1)
                           '(2 . "POINT")
                           (cons 410 (getvar 'CTAB))
                     )
              )
     )
   (repeat (setq i (sslength ss))
     (setq sn (ssname ss (setq i (1- i))))
     (setq nx (entnext sn))
     (while
       (/= (cdr (assoc 0 (setq e (entget nx)))) "SEQEND")
        (if (and (eq (cdr (assoc 0 e)) "ATTRIB")
                 (eq (strcase (cdr (assoc 2 e))) "POINT")
            )
          (setq l (cons (list sn (cdr (assoc 1 e))) l))
        )
        (setq nx (entnext nx))
     )
   )
 )
 (if (and l
          (setq f (vl-filename-mktemp nil nil ".dcl"))
          (setq fl (open f "w"))
     )
   (progn
     (foreach x
              (list
                "atts : dialog { label = \"List of Tags\"; width = 36;"
                ": list_box  { label = \"Tags of Point Block :\"; height = 20; key = \"pop\"; multiple_select = true; }"
                ": button      { label = \"okay\"; key = \"ok\"; is_default = true; }"
                "spacer = 0.5;"
                ": button      { label = \"Cancel\"; key = \"esc\"; is_cancel = true;}}")
       (write-line x fl)
     )
     (close fl)
   )
 )
 (setq id (load_dialog f))
 (if (not (new_dialog "atts" id))
   (exit)
 )
 (start_list "pop")
 (mapcar 'add_list (mapcar 'cadr l))
 (end_list)
 (action_tile
   "ok"
   "(setq lst (get_tile \"pop\")) (done_dialog)"
 )
 (action_tile "esc" "(done_dialog)")
 (start_dialog)
 (unload_dialog id)
 (vl-file-delete f)
 (if lst
   (progn
     (setq v (mapcar '(lambda (u) (nth u (mapcar 'cadr l)))
                     (read (strcat "(" lst ")"))
             )
     )
     (if (> (length v) 1)
       (progn
         (mapcar '(lambda (x)
                    (if (member (cadr x) v)
                      (setq grp (cons x grp))
                    )
                  )
                 l
         )
         (setq p (reverse grp))
         (while p
           (cond
             ((> (length p) 1)
              (entmakex
                (list
                  '(0 . "LINE")
                  (cons 10 (cdr (assoc 10 (entget (car (car p))))))
                  (cons
                    11
                    (setq pt (cdr (assoc 10 (entget (car (cadr p))))))
                  )
                )
              )
             )
             ((eq (length p) 1)
              (entmakex
                (list '(0 . "LINE")
                      (cons 10 pt)
                      (cons 11 (cdr (assoc 10 (entget (car (car p))))))
                )
              )
             )
           )
           (if (> (length p) 1)
             (setq p (cdr p))
             (setq p nil)
           )
         )
       )
     )
   )
 )
 (princ "\n Written by Tharwat Al Shoufi")
 (princ)
)

July 18, 2013

Nice idea Tharwat, saves me the trouble revising the code, I suggest you revised yours to accommodate the OPs request at post # 22

July 18, 2013

My friend Tharwat your lisp work fine but as i said

1. Can you make a choose to use line or polyline

2.I need to see the line or polyline from point to point and not all at the end (to avoid mistakes)

if choose from the list the points i have to go back in the drawing and check if are all ok.

if i give the number from point to point like imli.lsp (with the presupposition that i can see the line or polyline from point to point in real time) i think it is better

July 18, 2013

Tharwat

If i need to add and ather attributs like stations or tgigonometric points were can i add them in the code ....

tell me only this and i will use your lisp for for some time to check it better ...

many thanks and regards to all . Thanks for the time you spend for me i need to go now

July 18, 2013

Nice idea Tharwat,

Thank you pBe

My friend Tharwat your lisp work fine but as i said

1. Can you make a choose to use line or polyline

2.I need to see the line or polyline from point to point and not all at the end (to avoid mistakes)

Try this and let me know .

(vl-load-com)
(defun c:Test
      (/ *error* ss i l i sn nx l f fl id e lst grp p v pt ty pts)
;;; Author : Tharwat Al SHoufi     ;;;
 (defun *error* (x)
   (if (and f (setq f (findfile f)))
     (vl-file-delete f)
   )
   (princ "\*Cancel*")
 )
 (if (setq ss (ssget "_X"
                     (list '(0 . "INSERT")
                           '(66 . 1)
                           '(2 . "POINT")
                           (cons 410 (getvar 'CTAB))
                     )
              )
     )
   (repeat (setq i (sslength ss))
     (setq sn (ssname ss (setq i (1- i))))
     (setq nx (entnext sn))
     (while
       (/= (cdr (assoc 0 (setq e (entget nx)))) "SEQEND")
        (if (and (eq (cdr (assoc 0 e)) "ATTRIB")
                 (eq (strcase (cdr (assoc 2 e))) "POINT")
            )
          (setq l (cons (list sn (cdr (assoc 1 e))) l))
        )
        (setq nx (entnext nx))
     )
   )
 )
 (if (and l
          (setq f (vl-filename-mktemp nil nil ".dcl"))
          (setq fl (open f "w"))
     )
   (progn
     (foreach x
              (list
                "atts : dialog { label = \"List of Tags\"; width = 36;"
                ": list_box  { label = \"Tags of Point Block :\"; height = 20; key = \"pop\"; multiple_select = true; }"
                ": boxed_radio_column { label = \"Entity Type\";"
                ": radio_button { label = \"Line\"; key = \"l\"; value = \"1\";}"
                ": radio_button { label = \"LWPolyline\"; key = \"pl\";}}"
                ": button      { label = \"okay\"; key = \"ok\"; is_default = true; }"
                ": button      { label = \"Cancel\"; key = \"esc\"; is_cancel = true;}}")
       (write-line x fl)
     )
     (close fl)
   )
 )
 (setq id (load_dialog f))
 (if (not (new_dialog "atts" id))
   (exit)
 )
 (start_list "pop")
 (mapcar 'add_list (mapcar 'cadr l))
 (end_list)
 (action_tile
   "ok"
   "(setq lst (get_tile \"pop\") ty (get_tile \"l\")) (done_dialog)"
 )
 (action_tile "esc" "(done_dialog)")
 (start_dialog)
 (unload_dialog id)
 (vl-file-delete f)
 (if lst
   (progn
     (setq v (mapcar '(lambda (u) (nth u (mapcar 'cadr l)))
                     (read (strcat "(" lst ")"))
             )
     )
     (if (> (length v) 1)
       (progn
         (mapcar '(lambda (x)
                    (if (member (cadr x) v)
                      (setq grp (cons x grp))
                    )
                  )
                 l
         )
         (setq p (reverse grp))
         (if (eq ty "1")
           (while p
             (cond
               ((> (length p) 1)
                (entmakex
                  (list
                    '(0 . "LINE")
                    (cons 10 (cdr (assoc 10 (entget (car (car p))))))
                    (cons
                      11
                      (setq
                        pt (cdr (assoc 10 (entget (car (cadr p)))))
                      )
                    )
                  )
                )
               )
               ((eq (length p) 1)
                (entmakex
                  (list
                    '(0 . "LINE")
                    (cons 10 pt)
                    (cons 11 (cdr (assoc 10 (entget (car (car p))))))
                  )
                )
               )
             )
             (if (> (length p) 1)
               (setq p (cdr p))
               (setq p nil)
             )
           )
           (progn
             (mapcar
               '(lambda (u)
                  (setq
                    pts (cons (cdr (assoc 10 (entget (car u)))) pts)
                  )
                )
               p
             )
             (entmakex
               (append (list '(0 . "LWPOLYLINE")
                             '(100 . "AcDbEntity")
                             '(100 . "AcDbPolyline")
                             (cons 90 (length pts))
                             '(70 . 0)
                       )
                       (mapcar (function (lambda (p) (cons 10 p))) pts)
               )
             )
           )
         )
       )
     )
   )
 )
 (princ "\n Written by Tharwat Al Shoufi")
 (princ)
)

July 18, 2013

Can you make a choose to use line or polyline

This would be easy to achieve by yourself by simply exploding the polyline after is created by one of the above routines.

July 18, 2013

This would be easy to achieve by yourself by simply exploding the polyline after is created by one of the above routines.

Already included in my last routine and there is no need to explode anything .

July 18, 2013

This would be easy to achieve by yourself by simply exploding the polyline after is created by one of the above routines.

My thinking was to create the segments as lines then prompt to convert to polyline, that way its easy to include an Undo for every segment created (to avoid mistakes) , thats why i said "it wont be the end of it"

July 18, 2013

Here's a quick mod of the code i posted to demonstrate what i meant by undo and pedit.

(defun c:lineat (/ data AllPointnumber stop pts data i p pv pts_)
(vl-load-com)
(setq ped (getvar 'peditaccept))
(setvar 'peditaccept 1)
(if (setq AllPointnumber nil stop nil pts nil
   data (ssget "_X" (list '(0 . "INSERT")'(66 . 1)'(2 . "Point")(cons 410 (getvar 'Ctab)))))
 	(progn
  (repeat (setq i (sslength data))
    (if	(setq
	  p (vl-some '(lambda (x)
			(if (eq (vla-get-tagstring x) "POINT")
			  (list	(vla-get-textstring x)
				(vlax-get e 'Insertionpoint)
			  )
			)
		      )
		     (vlax-invoke
		       (setq e (vlax-ename->vla-object
				 (ssname data (setq i (1- i)))
			       )
		       )
		       'GetAttributes
		     )
	    )
	)
      (setq AllPointnumber (cons p AllPointnumber))
    )
  )
(setq 2bjoin (ssadd))
         (while (null Stop)
               (setq pv   (getstring "\nEnter point value <Enter for None>: "))
               (cond
                     ((setq a (assoc (strcase pv) AllPointnumber))
                      (setq pts (cons (cadr a) pts) pts_ (cons (cadr a) pts_))
                      (if (= (length pts) 2)
                          (progn
			(entmakex (list (cons 0 "LINE")
			(cons 10 (car pts))
			(cons 11 (cadr pts))))
                               (setq  pts (list (car pts)))(ssadd (entlast) 2bjoin)
                               )
                          )
                      )
                     ((eq pv "") (setq stop "Done"))
                     ((eq (strcase pv) "U")
                      (entdel (setq del (ssname 2bjoin (1- (sslength 2bjoin)))))(ssdel  del 2bjoin)
                      (setq pts_ (cdr pts_) pts  (list (car pts_)) ))
                     ((null a) (princ "\n<<Point value not found>>")) 	
                     ))
         (initget "Yes No")
  (setq convert (cond ( (getkword "\nConvert to polylines? [Yes/No] <Y>: ") ) ( "Yes" )))
         (if (eq "Yes" convert)
             (command "_.pedit" "_M" 2bjoin  "" "_J" "" ""))
         )
   )
   (setvar 'peditaccept ped)
     (princ)
     )

July 18, 2013

I will try to help a litle more

I have this old code but is not working with block attributes ...... can any one convert it

You took this long to mention that you already had code to do this?

A little more? It's practically done!

:surrender:wait sorry i think that it works wait a minite to check it again ..........

You didn't even give it a fair try before posting?

The lineat.lsp work fine but i need to see the line from point to point an not to see all lines at the end ...........(to avoid mistakes)

And then you say it actually works.

Unbelievable!

ok now imli.lsp works fine like lineat.lsp .

1. Can you make a choose to use line or polyline

2.I need to see the line or polyline from point to point and not all at the end (to avoid mistakes)

I just knew this was coming.

That two items will be the end i promise

Yeah, right.

The thing is, you could have mentioned what you wanted at the outset. I think others are right, you don't think these things through. But worse, you withheld information that you knew you had and might've been really useful. Is that really necessary?

My friend Tharwat your lisp work fine but as i said

1. Can you make a choose to use line or polyline

2.I need to see the line or polyline from point to point and not all at the end (to avoid mistakes)

if choose from the list the points i have to go back in the drawing and check if are all ok.

if i give the number from point to point like imli.lsp (with the presupposition that i can see the line or polyline from point to point in real time) i think it is better

If you want to avoid mistakes and not have to do it all over manually, then a better approach would be to create a point name text file and read that with the program. Then, if there is a problem, just delete the LWPOLYLINE, edit the simple text file and run the program again. Then, you wouldn't need a Line option, as you can EXPLODE the polyline when done, though I would think keeping the polyline would be better. Oh, well.

To all of you who helped, my hat's off to you, as much for your patience as for you skills.

July 18, 2013

So its everyone's fault who tried to help by giving the OP what he asked for instead of what he needed!

No good deed goes uncriticized it seems.

July 18, 2013

So its everyone's fault who tried to help by giving the OP what he asked for instead of what he needed!

No good deed goes uncriticized it seems.

Hi, ReMark! I hope this wasn't directed at my overview recounting the entertainment.

The only comment regarding anyone but the OP (besides their correct evaluations of the OP) was this:

To all of you who helped, my hat's off to you, as much for your patience as for you[r] skills.

I would hardly consider that criticism of them. Does it sound that way? I had meant it as praise.

July 18, 2013

Nice job pBe your lisp is exactly what i want !!!!!!

(defun c:lineat (/ data AllPointnumber stop pts data i p pv pts_)
(vl-load-com)
(setq ped (getvar 'peditaccept))
(setvar 'peditaccept 1)
(if (setq AllPointnumber nil stop nil pts nil
   data (ssget "_X" (list '(0 . "INSERT")'(66 . 1)'(2 . "Point")(cons 410 (getvar 'Ctab)))))
 	(progn
  (repeat (setq i (sslength data))
    (if	(setq
	  p (vl-some '(lambda (x)
			(if (eq (vla-get-tagstring x) "POINT")
			  (list	(vla-get-textstring x)
				(vlax-get e 'Insertionpoint)
			  )
			)
		      )
		     (vlax-invoke
		       (setq e (vlax-ename->vla-object
				 (ssname data (setq i (1- i)))
			       )
		       )
		       'GetAttributes
		     )
	    )
	)
      (setq AllPointnumber (cons p AllPointnumber))
    )
  )
(setq 2bjoin (ssadd))
         (while (null Stop)
               (setq pv   (getstring "\nEnter point value <Enter for None>: "))
               (cond
                     ((setq a (assoc (strcase pv) AllPointnumber))
                      (setq pts (cons (cadr a) pts) pts_ (cons (cadr a) pts_))
                      (if (= (length pts) 2)
                          (progn
			(entmakex (list (cons 0 "LINE")
			(cons 10 (car pts))
			(cons 11 (cadr pts))))
                               (setq  pts (list (car pts)))(ssadd (entlast) 2bjoin)
                               )
                          )
                      )
                     ((eq pv "") (setq stop "Done"))
                     ((eq (strcase pv) "U")
                      (entdel (setq del (ssname 2bjoin (1- (sslength 2bjoin)))))(ssdel  del 2bjoin)
                      (setq pts_ (cdr pts_) pts  (list (car pts_)) ))
                     ((null a) (princ "\n<<Point value not found>>")) 	
                     ))
         (initget "Yes No")
  (setq convert (cond ( (getkword "\nConvert to polylines? [Yes/No] <Y>: ") ) ( "Yes" )))
         (if (eq "Yes" convert)
             (command "_.pedit" "_M" 2bjoin  "" "_J" "" ""))
         )
   )
   (setvar 'peditaccept ped)
     (princ)
     )

but i need to include same more attribute blocks because i use them all the time .. look the attach drawing

Is very important for me

Drawing1.dwg

July 18, 2013

neo: That comment was not directed at you. It was merely an observation about the overall event.

July 18, 2013

Any last help !!!!!!!

July 18, 2013

I made a mistake by spending that much time for no reply , but anyway it is a good lesson to not give a complete codes from now on for such users .

Sign In

Need Survey Stringing Lisp as soon as possible, Please

Recommended Posts

CAD89

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Guest

pBe

Guest

Tharwat

pBe

Guest

Guest

Tharwat

MSasu

Tharwat

pBe

pBe

neophoible

ReMark

neophoible

Guest

ReMark

Guest

Tharwat

Join the conversation

Tutorials

Forums

Activity