alanjt's Misc. Useful Lisp Routines

[Lee Mac]

Exactly how are you creating the hatch? I mean exactly.

[The Buzzard]

There are not too many ways. But since you ask, I draw a couple of rectangles, then use hatch on one and bhatch on the other just to cover all bases. I select ANSI31 pattern, Select the rectangle and go back to the bhatch dialog and say OK, Bingo! a hatch.

[The Buzzard]

Ok, I just tested on a third machine that I am embarrased to call a CAD computer DELL OPTIPLEX GX280, But all the same it has ACAD 2002, 2008 & 2009. I just did the same tests as previously outlined on all three versions on this machine and still get the same issue.

[alanjt]

Ok,

 

Just tested on my laptop. I made a simple drawing with a hatch. I ran the program and I get the same issue. It will not report back the AREA.

Well. Umm. Wow.

[Lee Mac]

There are not too many ways. But since you ask, I draw a couple of rectangles, then use hatch on one and bhatch on the other just to cover all bases. I select ANSI31 pattern, Select the rectangle and go back to the bhatch dialog and say OK, Bingo! a hatch.

 

Well, actually there are a few things that could make the difference. The area property being valid relies on a closed polyline, so I wanted to check that you used the rectangle command as opposed to using the polyline command to construct the rectangles manually. Also, whether you selected the objects or picked internal points etc.

[alanjt]

Well, actually there are a few things that could make the difference. The area property being valid relies on a closed polyline, so I wanted to check that you used the rectangle command as opposed to using the polyline command to construct the rectangles manually. Also, whether you selected the objects or picked internal points etc.

I would go along with you, but I can pick a point within a group of intersecting lines and still extract the area from the created hatch.

[The Buzzard]

Used rectangle as I have mentioned before. Also before you mention it, I also have (VL-LOAD-COM) in my acaddoc.lsp, So do not mention it.

[Lee Mac]

Also before you mention it, I also have (VL-LOAD-COM) in my acaddoc.lsp, So do not mention it.

 

Wasn't going to... if you didn't have vl-load-com then the vlax-get-acad-object would throw a function def error.

[alanjt]

(defun c:PC (/ p1 p2)
 ;; Point Calc
 ;; Alan J. Thompson, 04.19.10
 (if (zerop (getvar 'cmdactive))
   (princ "\nPC must be called from within another command.")
   (and (setq p1 (getpoint "\nSpecify first point: "))
        (setq p2 (getpoint p1 "\nSpecify new point: "))
        ((lambda (p)
           (vla-sendcommand
             (cond (*AcadDoc*)
                   ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
             )
             (strcat "_non " (car p) "," (cadr p) "," (caddr p) " ")
           )
         )
          (mapcar (function (lambda (x) (rtos x 2 16))) p2)
        )
   )
 )
 (princ)
)

[alanjt]

(defun c:IL (/ pt ss)
 ;; Ignore locked layers for picked point
 ;; Alan J. Thompson, 04.28.10
 (if (zerop (getvar 'cmdactive))
   (princ "\nIL must be called from within another command.")
   (while (not pt)
     (if
       (and
         (setq pt (getpoint "\nSpecify point (Locked layers will be ignored): "))
         (setq ss (ssget pt))
         (not
           (zerop
             (cdr (assoc 70 (entget (tblobjname "layer" (cdr (assoc 8 (entget (ssname ss 0))))))))
           )
         )
         (princ "\nCannot snap to object on locked layer!")
       )
        (setq pt nil)
        (if pt
          ((lambda (p)
             (vla-sendcommand
               (cond (*AcadDoc*)
                     ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
               )
               (strcat "_non " (car p) "," (cadr p) "," (caddr p) " ")
             )
           )
            (mapcar (function (lambda (x) (rtos x 2 16))) pt)
          )
        )
     )
   )
 )
 (princ)
)

[alanjt]

This is for all the users running older versions of AutoCAD that don't have M2P (Midpoint between two points)...

 

(defun c:M2P (/ p1 p2)
 ;; Midpoint Between Two Points (for older CAD versions)
 ;; Alan J. Thompson, 04.28.10
 (vl-load-com)
 (if (zerop (getvar 'cmdactive))
   (princ "\nMust be called from within another command.")
   (and (setq p1 (getpoint "\nFirst point of mid: "))
        (setq p2 (getpoint p1 "\nSecond point of mid: "))
        ((lambda (p)
           (vla-sendcommand
             (cond (*AcadDoc*)
                   ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
             )
             (strcat "_non " (car p) "," (cadr p) "," (caddr p) " ")
           )
         )
          (mapcar (function (lambda (x) (rtos x 2 16)))
                  (mapcar (function (lambda (a b) (/ (+ a b) 2.))) p1 p2)
          )
        )
   )
 )
 (princ)
)

 

Here's another way (put in a toolbar button):

_non;'cal (cur + cur)/2;

[alanjt]

;;; Copy Multiple Times
;;; Alan J. Thompson, 03.30.10
(defun c:CM (/ ss p1 p2)
 (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
 (or *CM:Num* (setq *CM:Num* 1))

 (and (setq ss (ssget "_:L"))
      (setq p1 (getpoint "\nSpecify base point: "))
      (if acet-ss-drag-move
        (setq p2 (acet-ss-drag-move ss p1 "\nSpecify next point: " T))
        (setq p2 (getpoint p1 "\nSpecify next point: "))
      )
      (setq p1 (trans p1 1 0)
            p2 (trans p2 1 0)
      )
      (not (initget 6))
      (setq *CM:Num* (cond ((getint (strcat "\nNumber of copies <" (itoa *CM:Num*) ">: ")))
                           (*CM:Num*)
                     )
      )
      ((lambda (d)
         (repeat *CM:Num*
           (setq d (+ (distance p1 p2) d))
           (vlax-for x (setq ss (vla-get-activeselectionset *AcadDoc*))
             (vla-move (vla-copy x)
                       (vlax-3d-point p1)
                       (vlax-3d-point (polar p1 (angle p1 p2) d))
             )
           )
         )
         (vla-delete ss)
       )
        0.
      )
 )
 (princ)
)

[alanjt]

;;; Boundary Acerage Label
;;; Required Subroutines: AT:Entsel, AT:MText
;;; Alan J. Thompson, 04.08.10
(defun c:BAL (/ obj pnt)
 (and (setq obj (AT:Entsel nil "\nSelect boundary: " '("V" (0 . "LWPOLYLINE") (70 . "1,129")) nil))
      ;;(or (vlax-curve-isClosed obj) (alert "LWPolyline must be closed!"))
      (setq pnt (getpoint "\nSpecify label location point: "))
      (AT:MText (trans pnt 1 0)
                (strcat "%<\\AcExpr (%<\\AcObjProp Object(%<\\_ObjId "
                        (itoa (vla-get-objectid obj))
                        ">%).Area \\f \"%lu2%pr2\">% / 43560.) \\f \"%lu2%pr2\">% AC.±"
                )
                nil
                nil
                5
      )
 )
 (princ)
)

[alanjt]

;;; Multileader Copy
;;; Required Subroutines: AT:Entsel, AT:TextString
;;; Alan J. Thompson, 04.07.09
(defun c:MC (/ #Ins #Land #Source)
 (and (setq #Ins (getpoint "\nSpecify first mleader point: "))
      (setq #Land (getpoint #Ins "\nSpecify next point: "))
      (setq #Source (car (AT:Entsel nil
                                    "\nSelect Source Text Object for Copying: "
                                    '("L" (0 . "ATTDEF,ATTRIB,MTEXT,MULTILEADER,TEXT"))
                                    nil
                         ) ;_ AT:Entsel
                    ) ;_ car
      ) ;_ setq
      (vl-cmdf "_.mleader" "_non" #Ins "_non" #Land "")
      (not (vla-put-textstring (vlax-ename->vla-object (entlast)) (AT:TextString #Source)))
      (not (initget 0 "Yes No"))
      (vl-position (getkword "\nDelete original? [Yes/No] <Yes>: ") '("Yes" nil))
      (entdel #Source)
 ) ;_ and
 (princ)
) ;_ defun