Author Topic: Trying to simplify or clean up  (Read 1213 times)

0 Members and 1 Guest are viewing this topic.

Biscuits

  • Bull Frog
  • Posts: 495
Trying to simplify or clean up
« on: November 29, 2021, 02:42:14 PM »
This routine is used in mapping underground fiber optics.
Working with an existing polyline, the user indicates the length of the bore required,
selects a point on the existing polyline, and a circle is created based on that information.
The user then selects the two intersections created by the circle and the polyline.
Two smaller circles are then created at those intersections and the original polyline.
A new polyline is drawn between the two smaller circles and offset to both sides.
The larger and the new polyline are then deleted.
This routine works great. I'm just looking for advice on how to improve, simplify and/or clean it up a bit.
Any help would be much appreciated.
Thanks and have a great holiday season!

Code: [Select]
;Bore by length

(defun C:TN2 (/ na nab lastent1 lastent2 pt1 pt2 o s)

(vl-load-com)

     (command "-layer" "s" "LAND_BORE" "")

(setq na (getint "\nTotal Bore Length : "))

(setq nab (/ na 2.0))

(prompt "\nSelect Circle Centerpoint")

(command "circle" "nea" pause nab)
(setq lastEnt1 (entlast))

(SETQ PT1 (GETPOINT "\nSelect 1st Point:"))
    (COMMAND "Circle" PT1 "D" "3.6")
(COMMAND "CHPROP" "L" "" "C" "RED" "")

(SETQ PT2 (GETPOINT "\nSelect 2nd Point:"))
   (COMMAND "Circle" PT2 "d" "3.6")
(COMMAND "CHPROP" "L" "" "C" "RED" "")

(command "pline" PT1 PT2 "")
(setq lastEnt2 (entlast))

 (setq o 1.7999999)

 (setq s (ssget "L" '((0 . "*LINE,CIRCLE,ARC,ELLIPSE"))))
   (foreach v (list o (- o))
     (vla-Offset (vlax-EName->vla-Object (ssname s 0)) v)
     )

(COMMAND "ERASE" LASTENT1 "")
(COMMAND "ERASE" LASTENT2 "")
 (princ)
)

JohnK

  • Administrator
  • Seagull
  • Posts: 10120
Re: Trying to simplify or clean up
« Reply #1 on: November 29, 2021, 03:07:11 PM »
Are you looking for more error checking and or "safer operations" as well? The program is pretty clean as it is (you cannot get much more bare-bones) unless you are wanting to use less "command".
TheSwamp.org (serving the CAD community since 2003)

Donate to TheSwamp.org

Biscuits

  • Bull Frog
  • Posts: 495
Re: Trying to simplify or clean up
« Reply #2 on: November 29, 2021, 03:20:34 PM »
Thank you for your opinion. Wouldn't mind fewer steps for the user maybe better automation.
Mostly curious if it could use any improvements. Thanks

JohnK

  • Administrator
  • Seagull
  • Posts: 10120
Re: Trying to simplify or clean up
« Reply #3 on: November 29, 2021, 03:26:48 PM »
What do you consider improvement? I would have built the lisp differently but if its working fine...
TheSwamp.org (serving the CAD community since 2003)

Donate to TheSwamp.org

JohnK

  • Administrator
  • Seagull
  • Posts: 10120
Re: Trying to simplify or clean up
« Reply #4 on: November 29, 2021, 03:46:43 PM »
I spent a minute adding some comments/questions for you to answer/think about.

Code - Auto/Visual Lisp: [Select]
  1. (defun C:TN2 (/ na nab lastent1 lastent2 pt1 pt2 o s)
  2.  
  3.  
  4.  (command "-layer" "s" "LAND_BORE" "")
  5.  ;; if the layer doesn't exist:
  6.  ;;  - I would add in a check to build layer if it doesnt exist.
  7.  ;; if the layer exists:
  8.  ;;  - I would add a check to ensure that the layer isnt frozen or off.
  9.  
  10.  (setq na (getint "\nTotal Bore Length : "))
  11.  ;; I would add a default bore lenght.
  12.  
  13.  (setq nab (/ na 2.0))
  14.  ;; I would check you can divide the number by 2 -i.e. >= 0
  15.  
  16.  (prompt "\nSelect Circle Centerpoint")
  17.  (command "circle" "nea" pause nab)
  18.  ;; What if point selected is NOT on circle?
  19.  
  20.  (setq lastEnt1 (entlast))
  21.  
  22.  (SETQ PT1 (GETPOINT "\nSelect 1st Point:"))
  23.  (COMMAND "Circle" PT1 "D" "3.6")
  24.  (COMMAND "CHPROP" "L" "" "C" "RED" "")
  25.  ;; What if point selected isnt on circle?
  26.  
  27.  (SETQ PT2 (GETPOINT "\nSelect 2nd Point:"))
  28.  (COMMAND "Circle" PT2 "d" "3.6")
  29.  (COMMAND "CHPROP" "L" "" "C" "RED" "")
  30.  ;; What if point selected isnt on circle?
  31.  
  32.  ;; -The last two clode blocks are essentially the same; couldn't we "simplify"
  33.  ;;  this by making a special function to call (twice)?
  34.  
  35.  (command "pline" PT1 PT2 "")
  36.  (setq lastEnt2 (entlast))
  37.  
  38.  (setq o 1.7999999)
  39.  
  40.  (setq s (ssget "L" '((0 . "*LINE,CIRCLE,ARC,ELLIPSE"))))
  41.  (foreach v (list o (- o))
  42.   (vla-Offset (vlax-EName->vla-Object (ssname s 0)) v)
  43.  )
  44.  
  45.  (COMMAND "ERASE" LASTENT1 "")
  46.  (COMMAND "ERASE" LASTENT2 "")
  47.  (princ)
  48. )
TheSwamp.org (serving the CAD community since 2003)

Donate to TheSwamp.org

Biscuits

  • Bull Frog
  • Posts: 495
Re: Trying to simplify or clean up
« Reply #5 on: November 29, 2021, 04:02:25 PM »
Thanks...certainly points to ponder.

JohnK

  • Administrator
  • Seagull
  • Posts: 10120
Re: Trying to simplify or clean up
« Reply #6 on: November 29, 2021, 04:29:02 PM »
Thanks...certainly points to ponder.


Now you have a good start to some questions you can ask. For example:
 


SUBJECT: Offering a default integer value when prompting user

BODY:
If I want to promt the user for an integer, how can I offer a default value. I would like them to be able to hit ENTER to accept the default value I offer.

My current code is:
Code - Auto/Visual Lisp: [Select]
  1. (setq na (getint "\nTotal Bore Length : "))


SUBJECT: Check if a number is greater than 0?

BODY:
I would like to check that a number is larger than zero before I divide by two.
Is this correct?
Code - Auto/Visual Lisp: [Select]
  1. (if (>= nab 0)
  2.   (setq nab (/ na 2.0)))


etc.
TheSwamp.org (serving the CAD community since 2003)

Donate to TheSwamp.org

BIGAL

  • Swamp Rat
  • Posts: 989
  • 40 + years of using Autocad
Re: Trying to simplify or clean up
« Reply #7 on: November 30, 2021, 01:10:03 AM »
try this instead of chprop (setvar 'cecolor "1") must do before draw circle but only once "256" I think should do bylayer.

also
(SETQ PT2 (GETPOINT pt1 "\nSelect 2nd Point:"))
A man who never made a mistake never made anything

Biscuits

  • Bull Frog
  • Posts: 495
Re: Trying to simplify or clean up
« Reply #8 on: November 30, 2021, 07:45:30 AM »
I'll try that...thank you!

BIGAL

  • Swamp Rat
  • Posts: 989
  • 40 + years of using Autocad
Re: Trying to simplify or clean up
« Reply #9 on: December 01, 2021, 01:10:52 AM »
Re read the post The user then selects the two intersections created by the circle and the polyline.

So it should all happen just based on the 1 pick point.

You draw a circle when you do a VL INTERSECTWITH it will find 2 points if applicable, so no need to pick the other points !

Code: [Select]
(defun c:conduit ( / rad off oldsnap obj1 obj2 intpt ent

(vl-load-com)
(setq rad (/ (getreal "\nEnter length ") 2.0))
(setq off 1.7999999)
(setq ent (entsel "Pick obj point"))
(setq pt (cadr ent))
(setq pt  (vlax-curve-getclosestpointto (vlax-ename->vla-object (car ent)) pt))
(setq obj1 (vlax-ename->vla-object (car ent)))
(command "circle" pt rad)
(setq obj2 (vlax-ename->vla-object (entlast)))
(setq intpt (vlax-invoke obj2 'intersectWith obj1 acExtendThisEntity))
(command "line" (list (nth 0 intpt)(nth 1 intpt))(list (nth 3 intpt)(nth 4 intpt)) "")
(setq ent (vlax-ename->vla-object (entlast)))
(vla-offset ent off)
(vla-offset ent (- 0.0 off))
(vla-delete obj2)
(vla-delete ent)
(command "circle" (list (nth 0 intpt)(nth 1 intpt)) 1.8 )
(command "circle" (list (nth 3 intpt)(nth 4 intpt)) 1.8)
(princ)
)

(c:conduit)
« Last Edit: December 01, 2021, 01:32:55 AM by BIGAL »
A man who never made a mistake never made anything

mhupp

  • Newt
  • Posts: 163
Re: Trying to simplify or clean up
« Reply #10 on: December 01, 2021, 01:16:41 AM »
This will only ask you for the Total Bore length and Center point of Boar.

Code: [Select]
(defun C:FOO2 (/ TBL lastEnt1 lastEnt2 obj1 obj2 pts pt)
  (vl-load-com)
  (setvar 'cmdecho 0)
  (if (tblsearch "layer" "LAND_BORE") ;if layer LAND_BORE exits switch to it else make it
    (command "-layer" "_S" "LAND_BORE" "")
    (command "-layer" "_M" "LAND_BORE" "")
  )
  (setq TBL (getint "\nTotal Bore Length : "))
  (prompt "\nSelect Center point of Bore")
  (command "_.Circle" "nea" pause "_D" TBL) ;use total bore lenth to create circle with diameter opiton like you use with smaller circles.
  (setq lastEnt1 (entlast))
  (setq obj1 (vlax-ename->vla-object (car (nentselp (getvar "lastpoint"))))) ;select polyline
  (setq obj2 (vlax-ename->vla-object lastEnt1))
  (setq pts (LM:intersections obj1 obj2 acextendnone)) ;use lee mac's intersection funciont to get points
  (foreach pt pts
    (command "_.Circle" pt "D" "3.6")
    (command "_.Chprop" "L" "" "C" "1" "")
  )
  (command "_.Pline" pts "")
  (command "_.Chprop" "L" "" "C" "1" "")
  (setq lastEnt2 (entlast))
  (vla-Offset (vlax-EName->vla-Object lastEnt2) 1.7999999)
  (vla-Offset (vlax-EName->vla-Object lastEnt2) -1.7999999)
  (command "_.Erase" LASTENT1 LASTENT2 "")
  (setvar 'cmdecho 1)
  (princ)
)
;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;;     mod - [int] acextendoption enum of intersectwith method
(defun LM:intersections (ob1 ob2 mod / lst rtn)
  (if (and (vlax-method-applicable-p ob1 'intersectwith)
           (vlax-method-applicable-p ob2 'intersectwith)
           (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
      )
    (repeat (/ (length lst) 3)
      (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
            lst (cdddr lst)
      )
    )
  )
  (reverse rtn)
)

--edit--
BIGAL beat me too it but this you no longer have to pick the two points manualy
« Last Edit: December 01, 2021, 02:04:53 AM by mhupp »

BIGAL

  • Swamp Rat
  • Posts: 989
  • 40 + years of using Autocad
Re: Trying to simplify or clean up
« Reply #11 on: December 01, 2021, 01:33:27 AM »
Mhupp pasted at same time  :2funny:

oops forgot color and layer.

Ps a Boar is a wild pig
A man who never made a mistake never made anything

mhupp

  • Newt
  • Posts: 163
Re: Trying to simplify or clean up
« Reply #12 on: December 01, 2021, 02:26:30 AM »
damn my dyslexia

Biscuits

  • Bull Frog
  • Posts: 495
Re: Trying to simplify or clean up
« Reply #13 on: December 01, 2021, 02:08:20 PM »
Thanks for the effort guys...much appreciated. BIGAL's worked great as long as my osnaps are off. It was missing a ")" on the first line. MHUPP your routine created the two smaller circles, but one was twice the size as the other and I don't beleive it ever created the polyline to be offset.
Thanks again everyone...a round of cold ones on me!
 

mhupp

  • Newt
  • Posts: 163
Re: Trying to simplify or clean up
« Reply #14 on: December 01, 2021, 03:40:00 PM »
MHUPP your routine created the two smaller circles, but one was twice the size as the other and I don't believe it ever created the polyline to be offset.

This will happen if you input a Bore length is bigger then the polyline picked or pick to close to one end of the polyline.
this will result in either no intersections points between the circle and the polyline or only 1 intersecting point.  see picture.
Added error check for this that will alert you if two points aren't created and leave the original circle to see if you need to pick another point or make a smaller bore length.

Code: [Select]
(defun C:FOO2 (/ TBL lastEnt1 lastEnt2 obj1 obj2 pts pt)
  (vl-load-com)
  (setvar 'cmdecho 0)
  (if (tblsearch "layer" "LAND_BORE")       ;if layer LAND_BORE exits switch to it else make it
    (command "-layer" "_S" "LAND_BORE" "")
    (command "-layer" "_M" "LAND_BORE" "")
  )
  (setq TBL (getint "\nTotal Bore Length : "))
  (prompt "\nSelect Center Point of Bore")
  (command "_.Circle" "nea" pause "D" TBL)  ;use total bore lenth to create circle with diameter opiton like you use with smaller circles.
  (setq lastEnt1 (entlast))
  (setq obj1 (vlax-ename->vla-object (car (nentselp (getvar "lastpoint")))))  ;select polyline
  (setq obj2 (vlax-ename->vla-object lastEnt1))
  (if (and (setq pts (LM:intersections obj1 obj2 acextendnone)) (= (length pts) 2))
    (progn
      (foreach pt pts
        (command "_.Circle" pt "1.8")
        (command "_.Chprop" "L" "" "C" "1" "")
      )
      (command "_.Pline" pts "")
      (command "_.Chprop" "L" "" "C" "1" "")
      (setq lastEnt2 (entlast))
      (vla-Offset (vlax-EName->vla-Object lastEnt2) 1.8)
      (vla-Offset (vlax-EName->vla-Object lastEnt2) -1.8)
      (command "_.Erase" LASTENT1 LASTENT2 "")
    )
    (alert "You Need to Adjust Bore Length or Point on Polyline")
  )
  (setvar 'cmdecho 1)
  (princ)
)
;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;;     mod - [int] acextendoption enum of intersectwith method
(defun LM:intersections (ob1 ob2 mod / lst rtn)
  (if (and (vlax-method-applicable-p ob1 'intersectwith)
           (vlax-method-applicable-p ob2 'intersectwith)
           (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
      )
    (repeat (/ (length lst) 3)
      (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
            lst (cdddr lst)
      )
    )
  )
  (reverse rtn)
)
« Last Edit: December 01, 2021, 10:34:58 PM by mhupp »