Topic: ssget "f" help

[csgoh]

help needed to solve this problem. I have this function where it selects lines using ssget "f" method and calculates the intersection between the section line and the lines selected and draw the point and text at the intersection. however, at certain intersection, it seems that it is not so. Where have i gone wrong in my lisp?
i am using autocad map 2004.
attached is the lsp, dwg file and a doc relating to the entity list.
thank you.

[csgoh]

Any one

[hmspe]

I downloaded the drawings and the lisp file.  I removed the fence line, the nodes and the text, then I ran the lisp.  It marked all intersections, so the code works fine here.  R2004.

Martin
 

[csgoh]

but the dwg i posted was what i got when i ran the lisp. it seems to be returning the wrong entity. and thats, why it is not returning the nodes where it is supposed to be. Am I missing something??
and martin, if you could get the nodes at the intersection -which the lisp is supposed to do, so I could not understand the logic. Can any lisp gurus pls explain??

[kpblc]

I'm not guru, but i think you'll get an error when an object has been selected and has no intersection point (for example, z-coordinate is different). I tried this code:

Code: [Select]

(defun test (/
             pt_sel_start
             pt_sel_end
             selset
             space
             section_line
             layer_point
             layer_text
             txt_height
             loc:conv-vla-to-list
             _kpblc-layer-status-restore
             _kpblc-layer-status-save
             _kpblc-error-catch
             *error*
             )

  (defun *error* (msg)
    (_kpblc-layer-status-restore)
    (if *global-adoc*
      (vla-endundomark *global-adoc*)
      ) ;_ end of if
    (princ msg)
    (princ)
    ) ;_ end of defun

  (defun _kpblc-error-catch (protected-function
                             on-error-function
                             /
                             catch_error_result
                             )
    (setq catch_error_result (vl-catch-all-apply protected-function))
    (if (and (vl-catch-all-error-p catch_error_result)
             on-error-function
             ) ;_ end of and
      (apply on-error-function
             (list (vl-catch-all-error-message catch_error_result))
             ) ;_ end of apply
      catch_error_result
      ) ;_ end of if
    ) ;_ end of defun

  (defun _kpblc-layer-status-save (layers-on / item)
    (vlax-for item (vla-get-layers *global-adoc*)
      (setq *kpblc-list-layer-status*
             (append *kpblc-list-layer-status*
                     (list
                       (list item
                             (cons "freeze" (vla-get-freeze item))
                             (cons "lock" (vla-get-lock item))
                             ) ;_ end of list
                       ) ;_ end of list
                     ) ;_ end of append
            ) ;_ end of setq
      (if layers-on
        (progn
          (_kpblc-error-catch
            '(lambda ()
               (vla-put-freeze item :vlax-false)
               ) ;_ end of lambda
            nil
            ) ;_ end of _kpblc-error-catch
          (vla-put-lock item :vlax-false)
          ) ;_ end of progn
        ) ;_ end of if
      ) ;_ end of vlax-for
    ) ;_ end of defun

  (defun _kpblc-layer-status-restore (/ item)
    (if *kpblc-list-layer-status*
      (progn
        (foreach item *kpblc-list-layer-status*
          (_kpblc-error-catch
            '(lambda ()
               (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))
               ) ;_ end of LAMBDA
            nil
            ) ;_ end of _kpblc-error-catch
          (_kpblc-error-catch
            '(lambda ()
               (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
               ) ;_ end of lambda
            nil
            ) ;_ end of _kpblc-error-catch
          ) ;_ end of foreach
        ) ;_ end of progn
      ) ;_ end of if
    (setq *kpblc-list-layer-status* nil)
    ) ;_ end of defun

  (defun loc:conv-vla-to-list (value)
    (cond
      ((= (type value) 'variant)
       (loc:conv-vla-to-list (vlax-variant-value value))
       )
      ((= (type value) 'safearray)
       (if (>= (vlax-safearray-get-u-bound value 1) 0)
         (loc:conv-vla-to-list (vlax-safearray->list value))
         ) ;_ end of if
       )
      (t value)
      ) ;_ end of cond
    ) ;_ end of defun

  (vl-load-com)
  (or *global-adoc*
      (setq *global-adoc* (vla-get-activedocument (vlax-get-acad-object)))
      ) ;_ end of or
  (if
    (and
      (not
        (vl-catch-all-error-p
          (vl-catch-all-apply
            '(lambda ()
               (setq pt_sel_start (getpoint "\nSelect startpoint <Cancel> : "))
               ) ;_ end of lambda
            ) ;_ end of vl-catch-all-apply
          ) ;_ end of vl-catch-all-error-p
        ) ;_ end of not
      pt_sel_start
      (not (vl-catch-all-error-p
             (vl-catch-all-apply
               '(lambda ()
                  (setq pt_sel_end
                         (getpoint pt_sel_start
                                   "\nSelect endpoint <Cancel> : "
                                   ) ;_ end of getpoint
                        ) ;_ end of setq
                  ) ;_ end of lambda
               ) ;_ end of vl-catch-all-apply
             ) ;_ end of vl-catch-all-error-p
           ) ;_ end of not
      pt_sel_end
      (setq selset (ssget "_F" (list pt_sel_start pt_sel_end) '((0 . "*LINE"))))
      (> (sslength selset) 0)
      ) ;_ end of and
     (progn
       (vla-startundomark *global-adoc*)
       (_kpblc-layer-status-save nil)
       (mapcar
         '(lambda (x / lay)
            (setq lay (if (tblobjname "layer" (cdr (assoc "name" x)))
                        (vla-item (vla-get-layers *global-adoc*)
                                  (cdr (assoc "name" x))
                                  ) ;_ end of vla-item
                        (vla-add (vla-get-layers *global-adoc*)
                                 (cdr (assoc "name" x))
                                 ) ;_ end of vla-add
                        ) ;_ end of if
                  ) ;_ end of setq
            (vla-put-color lay (cdr (assoc "color" x)))
            (vla-put-linetype lay "Continuous")
            (vla-put-lineweight lay aclnwtbylwdefault)
            (vla-put-plottable lay :vlax-true)
            (vla-put-layeron lay :vlax-true)
            (vl-catch-all-apply
              '(lambda ()
                 (vla-put-freeze lay :vlax-false)
                 ) ;_ end of lambda
              ) ;_ end of vl-catch-all-apply
            ) ;_ end of lambda
         '((("name" . "WG-XSLINE") ("color" . 4))
           (("name" . "WG-INPTS") ("color" . 10))
           (("name" . "WG-INHTS") ("color" . 4))
           (("name" . "WG-XSTEXT") ("color" . 7))
           )
         ) ;_ end of mapcar
       (setq space        (vla-objectidtoobject
                            *global-adoc*
                            (vla-get-ownerid (vlax-ename->vla-object (ssname selset 0)))
                            ) ;_ end of vla-ObjectIDToObject
             section_line (vla-addline
                            space
                            (vlax-3d-point pt_sel_start)
                            (vlax-3d-point pt_sel_end)
                            ) ;_ end of vla-addline
             txt_height   (cdr (assoc 40 (entget (tblobjname "style" "Standard"))))
             txt_height   (cond ((= 0. txt_height) (getvar "textsize"))
                                (t txt_height)
                                ) ;_ end of cond
             ) ;_ end of setq
       (vla-put-layer section_line "WG-XSLINE")
       (foreach item
                     (vl-remove
                       'nil
                       (append
                         (list (entmakex (list '(0 . "TEXT")
                                               '(100 . "AcDbEntity")
                                               '(8 . "WG-XSTEXT")
                                               '(100 . "AcDbText")
                                               (cons 10 pt_sel_start)
                                               (cons 11 pt_sel_start)
                                               (cons 40 txt_height)
                                               '(1 . "CH 200.000")
                                               '(7 . "Standard")
                                               '(71 . 0)
                                               ) ;_ end of list
                                         ) ;_ end of entmakex
                               ) ;_ end of list
                         (mapcar
                           '(lambda (x / pt_int ent_lst)
                              (setq x       (vlax-ename->vla-object x)
                                    pt_int  (loc:conv-vla-to-list
                                              (vla-intersectwith
                                                x
                                                section_line
                                                acextendnone
                                                ) ;_ end of vla-intersectwith
                                              ) ; _ end
                                    ent_lst (list
                                              (_kpblc-error-catch
                                                (function
                                                  (lambda ()
                                                    (entmakex (list (cons 0 "POINT")
                                                                    (cons 10 pt_int)
                                                                    (cons 8 "WG-INPS")
                                                                    )
                                                              ) ; _ end of
                                                    ) ;_ end of lambda
                                                  ) ;_ end of function
                                                '(lambda (x)
                                                   (princ "\nNo intersection point!")
                                                   ) ;_ end of lambda
                                                ) ; _ end of
                                              (_kpblc-error-catch
                                                (function
                                                  (lambda ()
                                                    (entmakex
                                                      (list
                                                        (cons 0 "TEXT")
                                                        (cons 10 pt_int)
                                                        (cons 11 pt_int)
                                                        (cons 40 txt_height)
                                                        (cons 7 "Standard")
                                                        (cons 8 "WG-XSTEXT")
                                                        (cons 1 (rtos (caddr pt_int) 2 3))
                                                        (cons 72 1)
                                                        (cons 73 1)
                                                        ) ;_ end of list
                                                      ) ;_ end of entmakex
                                                    ) ;_ end of lambda
                                                  ) ;_ end of function
                                                '(lambda (x)
                                                   (princ "\nNo intersection point!")
                                                   ) ;_ end of lambda
                                                ) ; _ end of
                                              ) ;_ end of list
                                    ) ;_ end of setq
                              ) ;_ end of lambda
                           (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
                           ) ;_ end of mapcar
                         ) ;_ end of append
                       ) ;_ end of vl-remove
         (setq item (vlax-ename->vla-object item))
         (vla-put-color item 256)
         (vla-put-lineweight item aclnwtbylayer)
         (vla-put-linetype item "bylayer")
         ) ;_ end of foreach
       (vla-endundomark *global-adoc*)
       ) ;_ end of progn
     ) ;_ end of if
  ) ;_ end of defunSom functions over here are based on ruCAD.

[csgoh]

kind of odd. i ran my lisp a few times and only after the 3rd time it returns the actual result that is supposed to do as in pic2.jpg.
the pic1.jpg is what i got the first time i ran the lisp.
question , when we supply the list of coords for the (ssget "f" ptlst) - does it have to be 3D or 2d?
from the results i get the first time i ran the lisp, it seems to be returning the wrong entity
and after a couple of times, it returns the entity it is supposed to do.
So the only of selection of lines is only thru the ssget "f" ptlst - so i suppose the selection set return here is not correct the first time the lisp is tested.
and martin replied that he tested in r2004 and got it right the first time. so why the discrepancy?
kpblc, thanks for your reply - come cool functions you have there.

[ronjonp]

Your routine worked the first time for me...


Ron

[csgoh]

now,  i am getting more confused. ron, you got it right the first and so is martin, so i suppose that the codes are ok. if thats the case, could it be due to other factors in the setup of autocad in my system?? maybe like system variables ,etc not correct??