Author Topic: Debug - getting layer from selected object  (Read 3552 times)

0 Members and 1 Guest are viewing this topic.

Krushert

  • Seagull
  • Posts: 13679
  • FREE BEER Tomorrow!!
Debug - getting layer from selected object
« on: January 20, 2010, 09:13:39 PM »
I am cobbling this together from a handful of routines but I crashing at this point. 
Code: [Select]
  (setq objectlayer (cdr [color=red](assoc 8 PlineID)[/color]))Well that is what the debugger is telling me
Anyway I coming up with nothing on what to replace it with so I am asking for a little help.
Thanks a million.


Code: [Select]
;;;; User Selection of PolyLine and test thereof
  (IF
    (setq
      ss (ssget
   '((0 . "LWPOLYLINE"))
)
    )
     (setq
       PlineID
(vla-get-objectid (vlax-ename->vla-object (ssname ss 0)))
     )
  )

;;;; Generating of FeildString Variable for the plines length
;;;; Use the FIELD-command to compose the next line:  (itoa PlineID)
  (setq fieldstring
(strcat "%<\\AcObjProp Object(%<\\_ObjId "
(itoa PlineID)
">%).Length \\f \"%lu6\">%"
)
  )

  ;;;; Gathering Layer Info from User Selected object changes current layer to that of selected object
  (setq objectlayer (cdr [color=red](assoc 8 PlineID)[/color]))
  (setq curlay (getvar "clayer"))
  (setvar "clayer" objectlayer)
I + XI = X is true ...  ... if you change your perspective.

I no longer CAD or Model, I just hang out here picking up the empties beer cans

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Debug - getting layer from selected object
« Reply #1 on: January 20, 2010, 09:32:46 PM »

You're getting Entity, Object and Objectid mixed up.

See if this helps


Code: [Select]

(IF (setq ss (ssget '((0 . "LWPOLYLINE"))))
    (setq PlineID (vla-get-objectid
                      (vlax-ename->vla-object (setq ent (ssname ss 0)))
                  )
    )
)
;;
(setq layerName (cdr (assoc 8 (entget ent))))



;;//--------------------------------------
(IF (setq ss (ssget '((0 . "LWPOLYLINE"))))
    (setq PlineID (vla-get-objectid (vlax-ename->vla-object (ssname ss 0))))
)

(setq *AcadDocument (vla-get-activedocument (vlax-get-acad-object))
      layerObject   (vla-ObjectIDToObject *AcadDocument PlineID)
      layerName     (vla-get-layer layerObject)
)



;;//--------------------------------------
(IF (setq ss (ssget '((0 . "LWPOLYLINE"))))
    (setq
        PlineID (vla-get-objectid
                    (setq ObjectPline (vlax-ename->vla-object (ssname ss 0)))
                )
    )
)
(setq layerName (vla-get-layer ObjectPline))

;;//--------------------------------------
kdub in one timeline.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<-

Krushert

  • Seagull
  • Posts: 13679
  • FREE BEER Tomorrow!!
Re: Debug - getting layer from selected object
« Reply #2 on: January 20, 2010, 10:18:40 PM »
You're getting Entity, Object and Objectid mixed up. 
Thought as much from taking a breather and then studying past examples.  Looks like I got some reading to do with the above.   

I was trying to figure out how to use (setq layerName (cdr (assoc 8 (entget ent)))) in the first option that you show and I actually tried the vla-get-layer halfheartedly.   I see that I need that extra Setq in there somewhere.  Anyway I choose the 3rd option and the the routine works. 
I + XI = X is true ...  ... if you change your perspective.

I no longer CAD or Model, I just hang out here picking up the empties beer cans

Krushert

  • Seagull
  • Posts: 13679
  • FREE BEER Tomorrow!!
Re: Debug - getting layer from selected object
« Reply #3 on: January 20, 2010, 10:27:00 PM »
Just thought of something to kick this routine up a notch.  Where can I find some examples of combining the ssget function with the getpoint function all with one user pick?   

I need to cull the above info from a multi-segmented pline along with angle immediate segment that the user picked on and the point on where the user picked.  The latter two would be to insert a block on a pline at that point and rotate the block to align with pline.
I + XI = X is true ...  ... if you change your perspective.

I no longer CAD or Model, I just hang out here picking up the empties beer cans

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Debug - getting layer from selected object
« Reply #4 on: January 20, 2010, 10:31:41 PM »

Do you want multiple entitys

(ssget ....


or a single entity

(entsel ....
kdub in one timeline.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<-

Krushert

  • Seagull
  • Posts: 13679
  • FREE BEER Tomorrow!!
Re: Debug - getting layer from selected object
« Reply #5 on: January 20, 2010, 10:40:43 PM »

Do you want multiple entitys

(ssget ....


or a single entity

(entsel ....
I am selecting a single entity.    :?
I + XI = X is true ...  ... if you change your perspective.

I no longer CAD or Model, I just hang out here picking up the empties beer cans

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Debug - getting layer from selected object
« Reply #6 on: January 20, 2010, 11:29:53 PM »
To break the process up, see how this goes for a start ..
Note: Code reads best in the Mercury forum theme.
[add:] Profile->LookAndLayoutPreferences->CurrentTheme(change)->Mercury
LIBRARY FUNCTIONS
Code: [Select]
;;;------------------------------------------------------------------
;; (KDUB:ENTSel_3 <Promptmsg> <typelist > <nentselflag > )

(defun kdub:entsel_3 (promptmsg              ;
                      typelist               ; List of entity types allowed to be selected
                      nentselflag            ; If true nentsel permitted , otherwise use entsel.
                      /            pickok       returnvalue
                      tmp
                     )
  (setq promptmsg (strcat "\n"
                          (cond (promptmsg)
                                ("Select object")
                          )
                          " : "
                  )
  )
  (while (not pickok)
    (setvar "ERRNO" 0)
    (setq returnvalue (if nentselflag
                        (nentsel promptmsg)
                        (entsel promptmsg)
                      )
    )
    (cond
      ((= (getvar "ERRNO") 52)               ; enter
       ;; skip out
       (setq pickok t)
      )
      ((= (getvar "ERRNO") 7)
       (princ "Nothing found at selectedpoint. ")
      )
      ((and
         (setq tmp (entget (car returnvalue))) ; object type
         typelist
         (not (member (cdr (assoc 0 tmp)) (mapcar 'strcase typelist)))
       )                                     ; wrong type
       (alert
         (strcat "Selected object is not"
                 "\na "
                 (apply 'strcat
                        (cons (car typelist)
                              (mapcar '(lambda (x) (strcat "\nor " x))
                                      (cdr typelist)
                              )
                        )
                 )
                 ". "
         )
       )
      )
      ;; skip out
      ((setq pickok t))
    )
  )
  ;; return EntityENAME/PickPoint List
  returnvalue
)
;;;------------------------------------------------------------------
;;
(defun kdub:getsegment (obj pt / cpt eparam stparam)
  ;; Stig Madsen
  (cond
    ((setq cpt (vlax-curve-getclosestpointto obj pt t))
     (setq eparam (fix (vlax-curve-getendparam obj)))
     (if (= eparam
            (setq stparam (fix (vlax-curve-getparamatpoint obj cpt)))
         )
       (setq stparam (1- stparam))
       (setq eparam (1+ stparam))
     )
     (list eparam
           (vlax-curve-getpointatparam obj stparam)
           (vlax-curve-getpointatparam obj eparam)
     )
    )
  )
)
;;;------------------------------------------------------------------
;;


TEST CODE
Should return the start end endpoint of the Selected LINE or LWPOLYLINE Segment
Code: [Select]
(if (setq plineent (kdub:entsel_3 "Select Work line"
                                  '("LINE" "LWPOLYLINE")
                                  t
                   )
    )
  (progn (setq plineobj (vlax-ename->vla-object (car plineent))
               ;; PickPoint (osnap (cadr plineent) "_nea")
               PickPointWorld  (trans (osnap (cadr plineent) "_nea") acUCS acWorld)
                                  
         )
         (kdub:getsegment plineobj PickPointWorld)
  )
)


Once you understand that, deal with inserting the block.
« Last Edit: January 20, 2010, 11:45:47 PM by Kerry Brown »
kdub in one timeline.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<-

Krushert

  • Seagull
  • Posts: 13679
  • FREE BEER Tomorrow!!
Re: Debug - getting layer from selected object
« Reply #7 on: January 21, 2010, 12:37:34 PM »
Thanks Kerry.  I see it is not an easy nut to crack.  I will pick away at it and will be back with questions.
I + XI = X is true ...  ... if you change your perspective.

I no longer CAD or Model, I just hang out here picking up the empties beer cans

CAB

  • Global Moderator
  • Seagull
  • Posts: 10400
Re: Debug - getting layer from selected object
« Reply #8 on: January 21, 2010, 02:11:57 PM »
Here is an old routine that may be modified for your use.
Code: [Select]
;;  03.17.08 CAB modified the block insert to use the Scale of the first
;;    block inserted. Also changed the entget to getpoint for the object
;;    selection so that osnaps will be visible
;;  http://forums.cadalyst.com/showthread.php?p=20949#post20949

;| This routine is further modified by Alan Butler aka CAB aka CAB2k
   The routine will work with a block without attributes so I modified
   it to work with most blocks in that the break points are determined
   by the intersect points of LINES that are farthest apart.
   I renamed it BlockInsert for my use. I did minimal testing with a
   valve symbol inserted into a pline. No UCS testing.
   This routine works by exploding the block, then determining the intersect
   points. After the exploded block is removed.
   
   Note that this will not work with all blocks.
|;

;|Routine to label contours drawn by Line/Arc/Polyline. Originally penned by
  CiphDRMRS, aka T.Willey, on the AUGI Forums. Modified by Jeff Mishler.
  An assumption is made that a valid block with 1 attribute is selected.
  |;
(defun c:BlockInsert (/        atts      ent      entobj   inspt
                  intpts   lastent  oldecho  oldreq   oldosnap p1
                  p2       pt       sel      tmplist  tmplist2 tmpobj
                  inpt     re       elst  *error*
                 )
  ; (setq *bname nil) ; force new block each time, or
  ;;  paste at the command line to reset the block name
  (vl-load-com)
  (defun *error* (msg)
    (if msg
      (princ msg)
    )
    (setvar "attreq" oldreq)
    (setvar "osmode" oldosnap)
    (command "undo" "end")
    (setvar "cmdecho" oldecho)
    (princ)
  )

;; CAB 05/07/06
;;  group on the first three elements  A B C of a flat list A B C D E F
;;  list must be divisable by 3, no error checking
;;  InpLst is the flat list ((A B C) (D E F) (G H I)...)
(defun group_on3 (inplst / outlst tmp grp idx sub)
  (while inplst
    (setq outlst (cons (list (car inplst) (cadr inplst) (caddr inplst)) outlst))
    (setq inplst (cdddr inplst))
  )
  outlst
)

 
  (setq OldReq   (getvar "attreq")
        oldecho  (getvar "cmdecho")
        oldOsnap (getvar "osmode")
  )
  (setvar "cmdecho" 0)
  (command "undo" "end")
  (command "undo" "be")
  (setvar "attreq" 0)
  (setvar "osmode" 512)

  ;;  CAB made *bname var global so that I could reuse the var in a session
  ;;  If you want the block name to be changed at each start uncomment the next line
  ;;  (setq *bname nil)
 
  (while
    (and
      ;;  use getpoint for osnaps to work
      (setq inspt (getpoint "\n Select object where you wish the block to be inserted: "))
      (setq inspt (osnap inspt "_near"))
      (setq Sel (nentselp inspt))
    )
     (setq Ent    (car Sel)
           entObj (vlax-ename->vla-object Ent)
     )
     (if (not *bname)
       (progn
         (setvar "cmdecho" 1)
         (initdia)
         (command "_.insert")
         (command InsPt)
         (while (> (getvar "cmdactive") 0)
           (command pause)
         )
         (setvar "cmdecho" 0)
         (setq LastEnt (entlast)
       elst    (entget LastEnt)
               *bname  (cdr (assoc 2 elst))
       *ScaleX  (cdr (assoc 41 elst))
       *ScaleY  (cdr (assoc 42 elst))
         )
       )
       (progn
         (setvar "cmdecho" 1)
         (command "_.-insert" *bname)
         (command InsPt *ScaleX *ScaleY pause)
         (setvar "cmdecho" 0)
         (setq LastEnt (entlast))
       )
     )
     (setq tmpObj (vlax-ename->vla-object LastEnt)
           z      (last inspt)
     )
     (setq tmpList (vlax-invoke tmpObj 'Explode))
    ;;==================================================================
    ;;  CAB modified this section & removed some code
     (setq Intpts nil        ; CAB
           re     nil)
     (foreach i tmpList
       (mapcar '(lambda (x)
                  (vlax-invoke x 'move (list 0.0 0.0 0.0) '(0.0 0.0 1e99))
                  (vlax-invoke x 'move (list 0.0 0.0 0.0) '(0.0 0.0 -1e99))
                )
               (list entobj i)
       )
       ;;  collect all points of intersect
       ;;  CAB revised 11.08.07 to accommodate objects that have more than one
       ;;  intersect point
       (if (setq inpt (vlax-invoke entobj 'intersectwith i acextendnone)) ; CAB
           (setq inpt   (group_on3 inpt)   ;  CAB revised 11.08.07
                 intpts (append inpt intpts))  ;  CAB revised 11.08.07
       )
       (vlax-invoke entobj 'move (list 0.0 0.0 0.0) (list 0.0 0.0 z))
       (vlax-invoke i 'move (list 0.0 0.0 0.0) (list 0.0 0.0 z))
       (vla-delete i)
     )

    ;;==================================================================
    ;;  CAB added this section of code
    ;;  Find the two points farthest apart
    (mapcar
      '(lambda(x)
         (mapcar
           '(lambda(y)
              (cond
                ((null re)(setq re (list x y)))
                ((> (distance x y) (distance (car re) (cadr re)))
                (setq re (list x y)))
              )
            )
           IntPts
         )
       )
      IntPts
    )
    ;;  restore the Z
    (setq p1 (list (caar re) (cadar re) z)
          p2 (list (caadr re) (cadadr re) z))
    ;;==================================================================

     (if (and p1 p2)
       (command  "_.break"  Ent
         (trans p1 0 1) ; had to add trans to both points
         (trans p2 0 1) ; here is the second point
       )
       (progn
         (alert (strcat "Can not break object."
                        "\n  Error in getting the two points needed."
                        "\nSelect OK then select the 2 points to break at."
                )
         )
         (setvar "osmode" 32)
         (if (and (setq p1 (getpoint "\nFirst break point: "))
                  (setq p2 (getpoint p1 "....second break point: "))
             )
           (command ".break" Ent p1 p2)
         )
         (setvar "osmode" 512)
       )
     )
     (if (setq atts (vlax-invoke tmpObj 'getattributes))
       (vla-put-textstring (car atts) (rtos z 2 0))
     )
  )
  (*error* nil)
  (princ)
)
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Krushert

  • Seagull
  • Posts: 13679
  • FREE BEER Tomorrow!!
Re: Debug - getting layer from selected object
« Reply #9 on: January 21, 2010, 03:00:08 PM »
Thanks CAB.  I will take a look at this also.

This is all making my head start that spinning thing. :grazy:
I + XI = X is true ...  ... if you change your perspective.

I no longer CAD or Model, I just hang out here picking up the empties beer cans

Lee Mac

  • Seagull
  • Posts: 12752
  • London, England
Re: Debug - getting layer from selected object
« Reply #10 on: January 21, 2010, 03:11:04 PM »
This is the way that I would normally approach it, sometimes excluding the last condition, so that the user may exit if he/she doesn't select something:

Code: [Select]
(while
  (progn
    (setq ent (car (entsel "\nSelect Entity: ")))

    (cond (  (eq 'ENAME (type ent))

             (if (not (member (cdr (assoc 0 (entget ent))) '("LINE" "ARC")))

               (princ "\n** Invalid Object Selected **")))

          (t (princ "\n** Nothing Selected **")))))

Krushert

  • Seagull
  • Posts: 13679
  • FREE BEER Tomorrow!!
Re: Debug - getting layer from selected object
« Reply #11 on: January 22, 2010, 01:02:56 PM »
Guys I have been teleported to a project that needs to get out the door.  I will be back.  Thanks for the help.
I + XI = X is true ...  ... if you change your perspective.

I no longer CAD or Model, I just hang out here picking up the empties beer cans

nivuahc

  • Guest
Re: Debug - getting layer from selected object
« Reply #12 on: January 22, 2010, 05:02:16 PM »
I was thinking about something along these lines the other day and this is as far as I got (though I'm sure there are more better ways to go about it... I was sorta thinking out loud):

Code: [Select]
(setq Item (entsel)
      Pick (cadr Item)
      VLAItem (vlax-ename->vla-object (car Item))
      ItemAngle
       (* 180.0
          (/
            (angle
              (vlax-safearray->list
                (vlax-variant-value
                  (vlax-get-property VLAItem 'StartPoint)
                  )
                )
              (vlax-safearray->list
                (vlax-variant-value
                  (vlax-get-property VLAItem 'EndPoint)
                  )
                )
              )
            pi
            )
          )
      )
(princ "\nThe user picked the item at point ")(princ Pick)
(princ (strcat "\nThe angle of the item is " (rtos ItemAngle 2 2)))
(princ)

I'm purty darned positive that there's a better way to do it but I got about this far before I got pulled off and put on something else

CAB

  • Global Moderator
  • Seagull
  • Posts: 10400
Re: Debug - getting layer from selected object
« Reply #13 on: January 22, 2010, 06:32:07 PM »
How about with vlax-curve?
Code: [Select]
;;  GetAngle  CAB 01.22.2010
(defun c:GetAngle(/ ent pt ang)
  (vl-load-com)
  ;;  CAB test to see if vlax-curve can be used on an object
  (defun curveOK (ent) ; returns nil if not allowed
    (not (vl-catch-all-error-p
           (vl-catch-all-apply 'vlax-curve-getendparam (list ent))
         )
    )
  )
  ;;  Loop until something is picked
  (while (or (and (not (setq ent (entsel "\nSelect an object:")))
                  (princ "\nMissed, Try Again."))
     (and (not (curveOK (car ent)))
  (princ "\nNo Angle, Try Again.")))
  )
  (setq pt (vlax-curve-getclosestpointto (car ent) (cadr ent))
ent (car ent))
  (setq ang (angle '(0 0) (vlax-curve-getFirstDeriv ent (vlax-curve-getParamAtPoint ent pt))))

  (print ang)
  (princ)
)
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.