Temperamental LISP - Sometimes it works, Sometimes it doesn't!

[Lee Mac]

I have recently written a LISP (see code below) to draw an arrow (for use on a P&ID), hatch the arrow, then delete the original outline.

 

I first tried using the "pline" command, but found that the hatch sometimes couldn't find a boundary, so I resorted to using "hatch", "Solid", "Direct Hatch", and select the option to delete the outline polyline.

 

This method seems to work, but only sometimes.... why!?

 

Extra info... the arrow drawn is aligned with the line, and is 4x2 (hence a 1 in 4 slope).

 

[font=Trebuchet MS][color=Navy][size=3]; P&ID ARROW By LEE MCDONNELL 

(defun dtr (a)
   (* pi (/ a 180.0))
)

(defun rtd (b)
   (* 180.0 (/ b pi))
)

(defun usvales ()
   (setq inslin (entsel "\nSelect Line for Arrow: "))
   (setq inspts (getpoint "\nSelect Point for Arrow: "))
)

(defun linedirec ()
   (setq linnam (entget (car inslin)))
   (setq spt1 (cdr (assoc 10 linnam)))
   (setq ept1 (cdr (assoc 11 linnam)))
   (setq ang (angle spt1 ept1))
)

(defun hat ()    
   (setq leng1 2)
   (setq leng2 (sqrt 17))
   (setq ang1 (atan 0.25))
   (setq ang2 (+ ang1 ang))
   (setq ang3 (* 3 (/ pi 2)))
   (setq ang4 (+ ang3 ang))
   (setq p1 (polar inspts ang2 leng2))
   (setq p2 (polar p1 ang4 leng1))
   (command "hatch" "S" "" ""
       inspts p1 p2 inspts ""
   ""
   ) ; end hatch
   (setq arr1 (entlast))
)

(defun satisfy ()
   (setq ang5 180.0)
   (initget 1 "Yes No")
   (setq xy (getkword "\nRotate Arrow (Yes or No)?" ))
   (if (= xy "Yes")
       (command "rotate" arr1 "" inspts ang5)
       (princ "\nFunction Complete")
   ) ; end if
)

(defun c:pidarrow ()
   (setvar "cmdecho" 0)
   (usvales)
   (linedirec)
   (hat)
   (satisfy)
   (setvar "cmdecho" 1)
   (princ)
)
       
; ********************* END OF PROGRAM ***********************
[/size][/color][/font]

[CAB]

Lee,

Here is a quick fix to get you going again.

          ; P&ID ARROW By LEE MCDONNELL 

(defun usvales ()
 (setq inslin (entsel "\nSelect Line near Arrow End: "))
)

(defun linedirec ()
 (setq linnam (entget (car inslin)))
 (setq spt1 (cdr (assoc 10 linnam)))
 (setq ept1 (cdr (assoc 11 linnam)))
 (if (> (distance (cadr inslin) spt1)(distance (cadr inslin) ept1))
   (setq ang (angle spt1 ept1)
         arwpt ept1)
   (setq ang (angle ept1 spt1)
         arwpt spt1)
 )
)

(defun hat ()
 (command "_.pline"
          "_non" (polar arwpt (+ ang (/ pi 2)) 2)
          "_non" (polar arwpt ang 
          "_non" (polar arwpt (- ang (/ pi 2)) 2)
          "_C")
 (setq ent (entlast))
 (command "hatch" "S" (entlast) "" )
 (setq arr1 (entlast))
 (entdel ent)
)



(defun c:pidarrow ()
 (setvar "cmdecho" 0)
 (usvales)
 (linedirec)
 (hat)
 (setvar "cmdecho" 1)
 (princ)
)

         ; ********************* END OF PROGRAM ***********************

[bonacad]

CAB, works fine.

I added some quick makeup.

Lee MAC, if you find something mistyped, well,

i didn't lose my eyes on it...

 

                        ; P&ID ARROW By LEE MCDONNELL 
(DEFUN c:pda () (c:pidarrow)) ;shortcut
(DEFUN
  c:pidarrow  (/        usvales  inslin   linedirec         linnam
               inslin   spt1     ept1     ang      arwpt    hat
               ent      arr1     staraerr *error*  cmd      kwrd)
(DEFUN
   usvales  ()
 (SETQ inslin (ENTSEL "\nSelect one side of LINE for Arrow :"))
 (COND
  ((= inslin nil)
   (PROGN (PROMPT "\n  Yuo didn't select anything!") (usvales)))
  ((/= (SETQ wsel (CDR (ASSOC 0 (ENTGET (CAR inslin))))) "LINE") ;_ end of /=
   (PROGN
    (PROMPT
     (STRCAT
      "\n Selected object is "
      wsel
      ". Yuo can only select line!") ;_ end of STRCAT
     ) ;_ end of PROMPT
    (usvales)) ;_ end of PROGN
   )) ;_ end of COND
 ) ;_ end of DEFUN
(DEFUN
   linedirec  ()
 (SETQ linnam (ENTGET (CAR inslin)))
 (SETQ spt1 (CDR (ASSOC 10 linnam)))
 (SETQ ept1 (CDR (ASSOC 11 linnam)))
 (IF (> (DISTANCE (CADR inslin) spt1) (DISTANCE (CADR inslin) ept1)) ;_ end of >
  (SETQ
   ang   (ANGLE spt1 ept1)
   arwpt ept1) ;_ end of SETQ
  (SETQ
   ang   (ANGLE ept1 spt1)
   arwpt spt1) ;_ end of SETQ
  ) ;_ end of IF
 ) ;_ end of DEFUN
(DEFUN
   hat  ()
 (COMMAND
  "_.pline"
  "_non"
  (POLAR arwpt (+ ang (/ PI 2)) 2)
  "_non"
  (POLAR arwpt ang 
  "_non"
  (POLAR arwpt (- ang (/ PI 2)) 2)
  "_C") ;_ end of COMMAND
 (SETQ ent (ENTLAST))
 (COMMAND "hatch" "S" (ENTLAST) "")
 (SETQ arr1 (ENTLAST))
 (ENTDEL ent))          ;here start events
(SETQ staraerr *error*)
(DEFUN
   *error*  (msg)
 (PROGN (COMMAND "_.undo" "_e") (COMMAND "_.u") (SETVAR "cmdecho" cmd))
 (SETQ *error* staraerr)
 (PRINC "\n*Command P&ID ARROW By LEE MCDONNELL canceled*")) ;_ end of DEFUN
(SETQ cmd (GETVAR "cmdecho"))
(SETVAR "cmdecho" 0)
(COMMAND "_.undo" "_be")
(usvales)
(linedirec)
(hat)
(IF (NOT pdalw)         ;<--- about grouping easy to remove  Start
 (SETQ pdalw "No"))
(INITGET "Yes No")
(SETQ
 kwrd
 (GETKWORD (STRCAT "\nGroup line & arrow? [Yes/No] <" pdalw "> :")))
(IF (/= kwrd nil)
 (SETQ pdalw kwrd))
(IF (= pdalw "Yes")
 (PROGN
  (COMMAND "_.group" "_c" "*" "" arr1 inslin "")
  (PROMPT "\n Line Grouped & Arrowed!")))
(IF (/= pdalw "Yes")
 (PROMPT "\n Line Arrowed!")) ;<--- about grouping easy to remove  End
(COMMAND "_.undo" "_e")
(SETVAR "cmdecho" cmd)
(PRINC)) ;_ end of DEFUN

                        ; ********************* END OF PROGRAM ***********************

[VovKa]

one more

(defun c:pidarrow (/ Ent EntName Point Points)
 (and
   (setq Ent (entsel "\nSelect Line near Arrow End: "))
   (setq Point	  (cadr Ent)
  EntName (car Ent)
  Ent	  (entget EntName)
   )
   (= (cdr (assoc 0 Ent)) "LINE")
   (progn
     (setq Points (list (cdr (assoc 10 Ent)) (cdr (assoc 11 Ent))))
     (if (< (distance Point (car Points))
     (distance Point (cadr Points))
  )
(setq Points (reverse Points))
     )
     (entmakex
(append
  (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity"))
  (vl-remove-if
    (function
      (lambda (g) (vl-position (car g) '(-1 0 5 100 10 11 210)))
    )
    Ent
  )
  (list (cons 100 "AcDbPolyline") (cons 90 3) (cons 70 0))
  (mapcar (function (lambda (p) (cons 10 p))) Points)
  (list	(cons 40 4.)
	(cons 41 0.)
	(cons 10 (polar (cadr Points) (apply 'angle Points) 8.0))
  )
)
     )
   )
   (entdel EntName)
 )
)

[Lee Mac]

Hi Guys, thanks for the help!

 

I do have a few questions for CAB though,

 

1) Why do you have to include the distance between the point chosen and the start and end point of the line, and not just retrieve the angle?

 

2) Why must you use the "_non" prefix when inputting the points for the polyline?

 

Thanks for the help once again, much appreciated!

 

Lee

[CAB]

In reverse order.

"_non" is short for NONE and turns off any Osnaps you may have on.

If you use a COMMAND in lisp it honers the osnaps and causes all sorts of problems

drawing your geometry.

 

  (if (> (distance (cadr inslin) spt1)(distance (cadr inslin) ept1))
   (setq ang (angle spt1 ept1)
         arwpt ept1)
   (setq ang (angle ept1 spt1)
         arwpt spt1)
 )

This determines the closest end from the picked point from entsel. As you know entsel

returns the object selected and the point at the center of the pick box.

Note that this point may not be on the line as the object may be selected with the edge of the pick box.

You can get a point n the object if you need it using (setq pt (osnap (cadr inslin) "_nea")) but that too can

cause problems if other geometry is too close. The most reliable way to get the point is to use the

(vlax-curve-getclosestpointto curve-obj givenPnt [extend]) function.

But I digress too much.

This determines the closest end from the picked point from entsel by comparing the distance of the picked

point to each end. This will tell which end is closer.

[Lee Mac]

Thanks for the explanation, very informative!

 

I have used the (setq pt (osnap (cadr inslin) "_nea")) script in other LISPs that I have created and it works quite well, but I must admit, I have never heard of the (vlax-curve-getclosestpointto curve-obj givenPnt [extend]) script... very in-depth!

 

Thanks once again :wink:

 

Lee

[CAB]

The curve functions are very useful. Here is some more info:

 

  ;;  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))
        )
   )
 )

;;  CAB 07/29/06
;;  Example, Get an entity with the point on the object.
(defun c:myentsel (/ ent obj pt)
 (vl-load-com)
 (if (and (setq ent (entsel "\nSelect entity: ")) (curveOK (car ent)))
   (list (car ent)
         (trans (vlax-curve-getclosestpointto (car ent) (trans (cadr ent) 1 0)) 0 1)
   )
   ent
 )
)


  ;; if not in WCS, always trans the entsel point to WCS
 (setq pt (vlax-curve-getclosestpointto ent (trans (cadr esel) 1 0)))

NOTE that curve-obj can be an entity name as well as a vla-object

...............
(vlax-curve-getarea curve-obj)
(vlax-curve-getclosestpointto curve-obj givenPnt [extend])
(vlax-curve-getclosestpointtoprojection curve-obj givenPnt normal [extend])
(vlax-curve-getdistatparam curve-obj param)
(vlax-curve-getdistatpoint curve-obj point)
(vlax-curve-getendparam curve-obj)
(vlax-curve-getendpoint curve-obj)
(vlax-curve-getfirstderiv curve-obj param)
(vlax-curve-getparamatdist curve-obj dist)
(vlax-curve-getparamatpoint curve-obj point)
(vlax-curve-getpointatdist curve-obj dist)
(vlax-curve-getpointatparam curve-obj param)
(vlax-curve-getsecondderiv curve-obj param)
(vlax-curve-getstartparam curve-obj)
(vlax-curve-getstartpoint curve-obj)
(vlax-curve-isClosed ent) ; true if Closed
...............