Print Page - Trying to simplify or clean up

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Biscuits on November 29, 2021, 02:42:14 PM

Title: Trying to simplify or clean up
Post by: Biscuits 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)
)

Title: Re: Trying to simplify or clean up
Post by: JohnK 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".

Title: Re: Trying to simplify or clean up
Post by: Biscuits 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

Title: Re: Trying to simplify or clean up
Post by: JohnK 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...

Title: Re: Trying to simplify or clean up
Post by: JohnK 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]

(defun C:TN2 (/ na nab lastent1 lastent2 pt1 pt2 o s)
 
 (vl-load-com)
 
 (command "-layer" "s" "LAND_BORE" "")
 ;; if the layer doesn't exist:
 ;;  - I would add in a check to build layer if it doesnt exist.
 ;; if the layer exists:
 ;;  - I would add a check to ensure that the layer isnt frozen or off.
 
 (setq na (getint "\nTotal Bore Length : "))
 ;; I would add a default bore lenght.
 
 (setq nab (/ na 2.0))
 ;; I would check you can divide the number by 2 -i.e. >= 0
 
 (prompt "\nSelect Circle Centerpoint")
 (command "circle" "nea" pause nab)
 ;; What if point selected is NOT on circle?
 
 (setq lastEnt1 (entlast))
 
 (SETQ PT1 (GETPOINT "\nSelect 1st Point:"))
 (COMMAND "Circle" PT1 "D" "3.6")
 (COMMAND "CHPROP" "L" "" "C" "RED" "")
 ;; What if point selected isnt on circle?
 
 (SETQ PT2 (GETPOINT "\nSelect 2nd Point:"))
 (COMMAND "Circle" PT2 "d" "3.6")
 (COMMAND "CHPROP" "L" "" "C" "RED" "")
 ;; What if point selected isnt on circle?
 
 ;; -The last two clode blocks are essentially the same; couldn't we "simplify"
 ;;  this by making a special function to call (twice)?
 
 (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)
)

Title: Re: Trying to simplify or clean up
Post by: Biscuits on November 29, 2021, 04:02:25 PM

Thanks...certainly points to ponder.

Title: Re: Trying to simplify or clean up
Post by: JohnK on November 29, 2021, 04:29:02 PM

Quote from: Biscuits on November 29, 2021, 04:02:25 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]

(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]

(if (>= nab 0)
  (setq nab (/ na 2.0)))

etc.

Title: Re: Trying to simplify or clean up
Post by: BIGAL 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:"))

Title: Re: Trying to simplify or clean up
Post by: Biscuits on November 30, 2021, 07:45:30 AM

I'll try that...thank you!

Title: Re: Trying to simplify or clean up
Post by: BIGAL 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)

Title: Re: Trying to simplify or clean up
Post by: mhupp 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

Title: Re: Trying to simplify or clean up
Post by: BIGAL 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

Title: Re: Trying to simplify or clean up
Post by: mhupp on December 01, 2021, 02:26:30 AM

damn my dyslexia

Title: Re: Trying to simplify or clean up
Post by: Biscuits 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!

Title: Re: Trying to simplify or clean up
Post by: mhupp on December 01, 2021, 03:40:00 PM

Quote from: Biscuits on December 01, 2021, 02:08:20 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)
)

Title: Re: Trying to simplify or clean up
Post by: Biscuits on December 02, 2021, 08:11:43 AM

Polylines were plenty long. first pic shows original results. Second pic shows results from second version along with error message:
; error: Automation Error. Invalid input

Title: Re: Trying to simplify or clean up
Post by: mhupp on December 02, 2021, 02:14:02 PM

; error: Automation Error. Invalid input
Seems AutoCAD can't process list when making a polyline. Well it needs a little bit of help.
https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/create-polyline-from-a-list/td-p/856098

This works just fine in BricsCAD tho.
(command "_.Pline" pts "")

replace that line with this and should work after that.
(command "_.Pline" (car pts) (cadr pts) "")

Also I remember this from Lee Mac.
http://www.lee-mac.com/circletangents.html

Title: Re: Trying to simplify or clean up
Post by: Biscuits on December 02, 2021, 03:36:23 PM

Works like a charm. Thank you!

TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Biscuits on November 29, 2021, 02:42:14 PM