Author Topic: Help me to fix a code : Connect attribiute points with line by point number  (Read 1820 times)

0 Members and 1 Guest are viewing this topic.

mhy3sx

  • Newt
  • Posts: 115
Hi, is it possible to zoom every time to the given point area . I want to say not to zoom in to the given block point number but to a close area of the point.

Thanks

mhy3sx

  • Newt
  • Posts: 115
Hi I try to add
Code: [Select]
(vl-cmdf "mspace" "zoom" 20 pv)

To zoom near the select attribute number so ,I can see the next points. For the first point works but for the next points don't working. Any ideas?

Code - Auto/Visual Lisp: [Select]
  1.      
  2.         (defun c:lineat2 (/ data AllPointnumber stop pts data i p pv pts_)
  3.         (vl-load-com)
  4.         (setq ped (getvar 'peditaccept))
  5.         (setvar 'peditaccept 1)
  6.         (if (setq AllPointnumber nil stop nil pts nil
  7.                    data (ssget "_X" (list '(0 . "INSERT")'(66 . 1)'(2 . "Point,KORYFES,station,trigonom,KOKAEK,KOROT,Ktir")(cons 410 (getvar 'Ctab)))))
  8.                 (progn
  9.                   (repeat (setq i (sslength data))
  10.                     (if (setq
  11.                           p (vl-some '(lambda (x)
  12.                                         (if (eq (vla-get-tagstring x) "POINT")
  13.                                           (list (vla-get-textstring x)
  14.                                                 (vlax-get e 'Insertionpoint)
  15.                                           )
  16.                                         )
  17.                                       )
  18.                                      (vlax-invoke
  19.                                        (setq e (vlax-ename->vla-object
  20.                                                  (ssname data (setq i (1- i)))
  21.                                                )
  22.                                        )
  23.                                        'GetAttributes
  24.                                      )
  25.                             )
  26.                         )
  27.                       (setq AllPointnumber (cons p AllPointnumber))
  28.                     )
  29.                   )
  30.                 (setq allpointnumber (vl-remove-if (function (lambda (x) (eq (car x) ""))) allpointnumber))
  31.                 (setq 2bjoin (ssadd))
  32.                   (while (null Stop)
  33.                         (setq pv   (getstring "\nGive point number  <Space to continue or Enter to finish and convert to polyline> :"))
  34.                        (vl-cmdf "mspace" "zoom" 20 pv)  ; <--- I add it here
  35.                         (cond
  36.                               ((setq a (assoc (strcase pv) AllPointnumber))
  37.                                (setq pts (cons (cadr a) pts) pts_ (cons (cadr a) pts_))
  38.                                (if (= (length pts) 2)
  39.                                    (progn
  40.                                         (entmakex (list (cons 0 "LINE")
  41.                                         (cons 10 (car pts))
  42.                                         (cons 11 (cadr pts))))
  43.                                         (setq  pts (list (car pts)))(ssadd (entlast) 2bjoin)
  44.                                         )
  45.                                    )
  46.                                )
  47.                               ((eq pv "") (setq stop "Done"))
  48.                               ((eq (strcase pv) "U")
  49.                                (entdel (setq del (ssname 2bjoin (1- (sslength 2bjoin)))))(ssdel  del 2bjoin)
  50.                                (setq pts_ (cdr pts_) pts  (list (car pts_)) ))
  51.                               ((null a) (princ "\n<<Point value not found>>"))  
  52.                               ))
  53.                   (initget "Yes No")
  54.                   (setq convert (cond ((getkword "\nConvert to polylines? [Yes/No] <N>: ")) ( "No" )))
  55.                   (if (eq "Yes" convert)
  56.                       (command "_.pedit" "_M" 2bjoin  "" "_J" "" ""))
  57.                   )
  58.             )
  59.             (setvar 'peditaccept ped)
  60.               (princ)
  61.               )
  62.          
  63.  

Thanks

mhy3sx

  • Newt
  • Posts: 115
Is It possible?

Thanks

mhy3sx

  • Newt
  • Posts: 115
I find this code. This code  Find block by attribute value. Unfortunately, didn't work for multiple blocks. Find one attribute tag and stop. Can anyone fix it to work for multiple block tags and join it with lineat2 lisp code?  The idea is  when I use leanatt2 lisp code and give eatch  attribute tag number to join with line , to zoom center to each block (by given number), so I can see the block numbers nearby .


Code - Auto/Visual Lisp: [Select]
  1. (defun c:fatt (/ ov ss i en ed an ad)
  2.   (while (not ov)
  3.          (setq ov (getstring t "\nATTRIB Value To Search For:   ")))
  4.  
  5.   (and (setq ss (ssget "X" (list (cons 0 "INSERT")
  6.                                  (cons 66 1)
  7.                                  (if (getvar "CTAB")
  8.                                      (cons 410 (getvar "CTAB"))
  9.                                      (cons 67 (- 1 (getvar "TILEMODE")))))))
  10.         (setq i (sslength ss))
  11.         (while (not (minusp (setq i (1- i))))
  12.                (setq en (ssname ss i)
  13.                      ed (entget en)
  14.                      an (entnext en)
  15.                      ad (entget an))
  16.                (while (/= "seqend" (cdr (assoc 0 ad)))
  17.                       (if (= (strcase ov)
  18.                              (strcase (cdr (assoc 1 ad))))
  19.                           (progn
  20.                              (command "_.zoom" "_c" (cdr (assoc 10 ed)) "")
  21.                              (getstring "\nPress Enter To Continue Searching...")))
  22.                       (setq an (entnext an)
  23.                             ad (entget an)))))
  24.   (prin1))
  25.  
  26.  


Code - Auto/Visual Lisp: [Select]
  1.          
  2.             (defun c:lineat2 (/ data AllPointnumber stop pts data i p pv pts_)
  3.             (vl-load-com)
  4.             (setq ped (getvar 'peditaccept))
  5.             (setvar 'peditaccept 1)
  6.             (if (setq AllPointnumber nil stop nil pts nil
  7.                        data (ssget "_X" (list '(0 . "INSERT")'(66 . 1)'(2 . "Point,KORYFES,station,trigonom,KOKAEK,KOROT,Ktir")(cons 410 (getvar 'Ctab)))))
  8.                     (progn
  9.                       (repeat (setq i (sslength data))
  10.                         (if (setq
  11.                               p (vl-some '(lambda (x)
  12.                                             (if (eq (vla-get-tagstring x) "POINT")
  13.                                               (list (vla-get-textstring x)
  14.                                                     (vlax-get e 'Insertionpoint)
  15.                                               )
  16.                                             )
  17.                                           )
  18.                                          (vlax-invoke
  19.                                            (setq e (vlax-ename->vla-object
  20.                                                      (ssname data (setq i (1- i)))
  21.                                                    )
  22.                                            )
  23.                                            'GetAttributes
  24.                                          )
  25.                                 )
  26.                             )
  27.                           (setq AllPointnumber (cons p AllPointnumber))
  28.                         )
  29.                       )
  30.                     (setq allpointnumber (vl-remove-if (function (lambda (x) (eq (car x) ""))) allpointnumber))
  31.                     (setq 2bjoin (ssadd))
  32.                       (while (null Stop)
  33.                             (setq pv   (getstring "\nGive point number  <Space to continue or Enter to finish and convert to polyline> :"))
  34.                             (cond
  35.                                   ((setq a (assoc (strcase pv) AllPointnumber))
  36.                                    (setq pts (cons (cadr a) pts) pts_ (cons (cadr a) pts_))
  37.                                    (if (= (length pts) 2)
  38.                                        (progn
  39.                                             (entmakex (list (cons 0 "LINE")
  40.                                             (cons 10 (car pts))
  41.                                             (cons 11 (cadr pts))))
  42.                                             (setq  pts (list (car pts)))(ssadd (entlast) 2bjoin)
  43.                                             )
  44.                                        )
  45.                                    )
  46.                                   ((eq pv "") (setq stop "Done"))
  47.                                   ((eq (strcase pv) "U")
  48.                                    (entdel (setq del (ssname 2bjoin (1- (sslength 2bjoin)))))(ssdel  del 2bjoin)
  49.                                    (setq pts_ (cdr pts_) pts  (list (car pts_)) ))
  50.                                   ((null a) (princ "\n<<Point value not found>>"))  
  51.                                   ))
  52.                       (initget "Yes No")
  53.                       (setq convert (cond ((getkword "\nConvert to polylines? [Yes/No] <N>: ")) ( "No" )))
  54.                       (if (eq "Yes" convert)
  55.                           (command "_.pedit" "_M" 2bjoin  "" "_J" "" ""))
  56.                       )
  57.                 )
  58.                 (setvar 'peditaccept ped)
  59.                   (princ)
  60.                   )
  61.              
  62.      
  63.  

Thanks

kasmo

  • Newt
  • Posts: 28
Code - Auto/Visual Lisp: [Select]
  1. (defun c:lineat2 (/ data AllPointnumber stop pts data i p pv pts_)
  2. (setq ped (getvar 'peditaccept))
  3. (setvar 'peditaccept 1)
  4. (if (setq AllPointnumber nil stop nil pts nil
  5.                    data (ssget "_X" (list '(0 . "INSERT")'(66 . 1)'(2 . "Point,KORYFES,station,trigonom,KOKAEK,KOROT,Ktir")(cons 410 (getvar 'Ctab)))))
  6.                 (progn
  7.                   (repeat (setq i (sslength data))
  8.                         (if (setq
  9.                                   p (vl-some '(lambda (x)
  10.                                                                 (if (eq (vla-get-tagstring x) "POINT")
  11.                                                                   (list (vla-get-textstring x)
  12.                                                                                 (vlax-get e 'Insertionpoint)
  13.                                                                   )
  14.                                                                 )
  15.                                                           )
  16.                                                          (vlax-invoke
  17.                                                            (setq e (vlax-ename->vla-object
  18.                                                                                  (ssname data (setq i (1- i)))
  19.                                                                            )
  20.                                                            )
  21.                                                            'GetAttributes
  22.                                                          )
  23.                                         )
  24.                                 )
  25.                           (setq AllPointnumber (cons p AllPointnumber))
  26.                         )
  27.                   )
  28.                 (setq allpointnumber (vl-remove-if (function (lambda (x) (eq (car x) ""))) allpointnumber))
  29.                 (setq 2bjoin (ssadd))
  30.                   (while (null Stop)
  31.                                 (setq pv   (getstring "\nGive point number  <Space to continue or Enter to finish and convert to polyline> :"))
  32.                                 (cond
  33.                                           ((setq a (assoc (strcase pv) AllPointnumber))                                                
  34.                                            (setq pts (cons (cadr a) pts) pts_ (cons (cadr a) pts_))
  35.                                            (command "_zoom" "_c" (car pts) 20)
  36.                                            (if (= (length pts) 2)
  37.                                                    (progn
  38.                                                                 (entmakex (list (cons 0 "LINE")
  39.                                                                 (cons 10 (car pts))
  40.                                                                 (cons 11 (cadr pts))))
  41.                                                                 (setq  pts (list (car pts)))(ssadd (entlast) 2bjoin)
  42.                                                                 )
  43.                                                    )
  44.                                            )
  45.                                           ((eq pv "") (setq stop "Done"))
  46.                                           ((eq (strcase pv) "U")
  47.                                            (entdel (setq del (ssname 2bjoin (1- (sslength 2bjoin)))))(ssdel  del 2bjoin)
  48.                                            (setq pts_ (cdr pts_) pts  (list (car pts_)) ))
  49.                                           ((null a) (princ "\n<<Point value not found>>"))  
  50.                                           ))
  51.                   (initget "Yes No")
  52.                   (setq convert (cond ((getkword "\nConvert to polylines? [Yes/No] <N>: ")) ( "No" )))
  53.                   (if (eq "Yes" convert)
  54.                           (command "_.pedit" "_M" 2bjoin  "" "_J" "" ""))
  55.                   )
  56.         )
  57.         (setvar 'peditaccept ped)
  58.           (princ)
  59.           )

mhy3sx

  • Newt
  • Posts: 115
Thank you kasmo