Jump to content

searching for a lisp


Guest

Recommended Posts

Hi BIGAL , thanks for the replay. I am not using layouts so i need a lisp. Any ideas ?

 

Thanks

 

What BIGAL suggested is the easiest way to accomplish what you want. What's the harm in starting to use layouts now prodromosm.?

Link to comment
Share on other sites

What BIGAL suggested is the easiest way to accomplish what you want. What's the harm in starting to use layouts now prodromosm.?

 

1) I don't use layouts because i don't have a ploter to print my drawings. When i go out to print my drawings they don't know how to print from layouts.

2) I am cooperate with other offices and they don't know how to use layouts. They know few things about autocad

 

So the drawings i use is only in model space ......

 

If some one can help I would appreciate it ...

 

Thanks

Link to comment
Share on other sites

you can print PDF files without ploter, and send them, they can easly tack print out for using PDF files. its easy way to take plot.

Link to comment
Share on other sites

Please understand Paper Space was introduced for plotting in r11 about 23 years ago. You could show them how to use the F1 key, then if they still need help show them how to use the forums. If the people you work with don't understand the most simple basics of using AutoCAD maybe you need to hire someone who does or contract it out?

Link to comment
Share on other sites

I write this but a have some problem

 

;| Centroid.lsp  - returns in current UCS coordinates the centroid of
  a selected object that can be in any UCS:
    - region
    - 3Dsolid
    - circle
    - ellipse
    - closed polyline (heavy)
    - closed LWpolyline
    - closed planar spline
    - closed planar 3Dpolyline

If used transparently, returns a point list to the calling command:
   Command: line
   Specify first point: 'CENTROID
   Select object to find centroid:     <<select object, line starts>>
   Specify next point or [undo]:       <<continue line>>

If not used transparently, creates a POINT object on the current layer.

In either case, coordinates of the most recently selected object are
saved in symbol CENTRO for later use.

Does not work with hatches, objects that cross themselves, or other
2D objects that cannot be turned into REGIONs.

If the current layer is locked or off, it is unlocked and turned on.

by Bill Gilliss
bill <at> realerthanreal <dot> com
Comments and suggestions always welcome.

Many thanks to 
 Kent Cooper for (PolylineSelfCrossing)
 gile for (Normal3Points)

No warranty, either expressed or implied, is made as to the fitness of
this information for any particular purpose.   All materials are to be
considered 'as-is' and use thereof should be considered as at your own
risk.

ver 1.0  Apr 14 2010 - initial public release
Check for updates at www.realerthanreal.com/autolisp

Keywords: AutoCAD AutoLISP centroid OSNAP transparent
======================================================================
|;

(defun c:centroid 
 (/ *delobj *osmode e en entype ed obj prevEn newEn myerror
   polylineSelfCrossing Normal3Points CrossProduct Normalize ScaleVector
   setUCStoObject ucsSave makeRegion acadObj acadDoc *Modelspace 
   newUCS origUCS objUCS lay layStatus )

 (vl-load-com)

;;=======subroutines========
 ;;  Function name: PSC = Polyline Self-Crossing
 ;;  To determine whether a Polyline of any type Crosses itSelf.
 ;;  With 3D Polylines, must have true intersection in 3D,
 ;;  not apparent in 2D.
 ;;  Returns T if self-crossing, nil if not.
 ;;  by Kent Cooper
 (defun polylineSelfCrossing (poly / pltyp plobj plverts plints)
   (vl-load-com)
   (setq
     pltyp (cdr (assoc 0 (entget poly)))
     plobj (vlax-ename->vla-object poly)
     plverts (length
               (safearray-value
                 (variant-value (vla-get-Coordinates plobj))))
     plints (/ (length
                 (safearray-value
                   (variant-value
                     (vla-intersectwith plobj plobj acExtendNone)))) 3)
   ); end setq
   (setq plverts (/ plverts (if (= pltyp "LWPOLYLINE") 2 3)))
   (if (vlax-curve-isClosed poly)
     (< plverts plints); then - closed
     (if (equal (vlax-curve-getStartPoint poly)
                (vlax-curve-getEndPoint poly) 1e-; else - open
       (<= plverts plints); then - start/end at same place
       (<= plverts (1+ plints)); else - open
     ); end if
   ); end if
 ); end defun



; Normal3Points (gile) Ret normal vector of a planeof 3 points
(DeFun Normal3Points (p0 p1 p2)
 (Normalize (CrossProduct (mapcar '- p1 p0) (mapcar '- p2 p0))) )

; CrossProduct (gile)  two vectors (real)
(DeFun CrossProduct (v1 v2)
 (list	(- (* (cadr v1) (caddr v2)) (* (caddr v1) (cadr v2)))
(- (* (caddr v1) (car v2)) (* (car v1) (caddr v2)))
(- (* (car v1) (cadr v2)) (* (cadr v1) (car v2)))  ) )

; Normalize (gile)  Return  single unit vector
(DeFun Normalize (v)
 ((lambda (l)  (if (/= 0 l)  (ScaleVector v (/ 1 l))  )  )
   (distance '(0 0 0) v)  ))

; ScaleVector (gile) vector after multiplying it by a scalar
(DeFun ScaleVector (v s) (mapcar (function (lambda (x) (* x s))) v))



(defun ucsSave ( / allUCS newUCS)  ;;be sure current UCS has a name to return to
 (setq allUCS (vla-get-UserCoordinateSystems acaddoc))
 (setq origUCS
   (vla-add allUCS
 		(vlax-3d-point (trans '(0.0 0.0 0.0) 1 0))
 		(vlax-3d-point (trans '(1.0 0.0 0.0) 1 0))
 		(vlax-3d-point (trans '(0.0 1.0 0.0) 1 0))
 		"zz_centroid_01"
  )
 )
)

(defun setUCStoObject ( / allUCS newUCS)
 (setq pt (osnap (cadr e) "_near"))
 (setq newOrig (trans pt 1 0)) ;;pick point in WCS
 (if (or
       (eq entype "SPLINE")
       (and (eq entype "POLYLINE")(= 8 (logand 8 (cdr (assoc 70 ed)))))  ;;3Dpolyline
       )
     (progn
       (setq pt1 (vlax-curve-getPointatParam obj 1))
       (setq pt2 (vlax-curve-getPointatParam obj 2))
       (setq pt3 (vlax-curve-getPointatParam obj 3))
       (setq normal (Normal3Points pt1 pt2 pt3))
       )
     (setq normal (vlax-get obj 'Normal))
     )
 (setq allUCS (vla-get-UserCoordinateSystems acaddoc))
 (setq newUCS 
   (vla-add allUCS 
     (vlax-3D-point (trans '(0.0 0.0 0.0) normal 0))
     (vlax-3D-point (trans '(1.0 0.0 0.0) normal 0))
     (vlax-3d-point (trans '(0.0 1.0 0.0) normal 0)) 
     "zz_centroid_02"
     )
   )
;;move UCS origin to point picked on object   
 (vla-put-origin newUCS (vlax-3d-point newOrig 0 1))
 (vla-put-activeUCS acadDoc newUCS)  ;;update UCS
 )


(defun makeRegion ( entity / sa reg)
 (setq sa (vlax-make-variant
             (vlax-safearray-fill
               (vlax-make-safearray vlax-vbObject '(0 . 0))
                 (list entity)
                 )
               )
       reg (vla-addregion
             (vla-get-ModelSpace
               (vla-get-ActiveDocument
                 (vlax-get-acad-object)
                 )
               )
             sa
             )
       )
 )


;;=======main program========

 (defun myerror (msg)
   (setvar 'delobj *delobj)
   (setvar 'osmode *osmode)
   (if origUCS (vla-put-ActiveUCS acadDoc origUCS))
   (setq *error* olderror)
   )

 (setq olderror *error*)
 (setq *error* myerror)
 (setq *delobj (getvar 'delobj))
 (setvar 'delobj 0)
 (setq *osmode (getvar 'osmode))
 (setvar 'osmode 0)
 
 
;;be sure current layer is unlocked  
 (setq lay (entget (tblobjname "layer" (getvar 'clayer))))
 (setq laystatus (cdr (assoc 70 lay)))
 (if (= 4 (logand 4 laystatus))
     (progn
      (setq newLaystatus (cons 70 (- layStatus 4)))
      (setq lay (subst (cons 70 (- layStatus 4)) (assoc 70 lay) lay))
      (entmod lay)
      (entupd (cdr (assoc -1 lay)))
      )
     )  
;;and turned on  
 (setq lay (entget (tblobjname "layer" (getvar 'clayer))))
 (setq laystatus (cdr (assoc 62 lay)))
 (if (minusp laystatus)
     (progn
      (setq lay (subst (cons 62 (abs laystatus)) (assoc 62 lay) lay))
      (entmod lay)
      (entupd (cdr (assoc -1 lay)))
      )
     )  

;;be sure points show up when created
 (if (and
       (= 0 (getvar 'pdmode)) 
       (= 0 (getvar 'cmdactive))
       )
     (progn
       (setvar 'pdmode 34)
       (setvar 'pdsize 0)
       )
     )


 (setq acadObj (vlax-get-acad-object))
 (setq acadDoc (vla-get-activedocument acadObj))
 (setq *ModelSpace (vla-get-ModelSpace acadDoc))
 (ucsSave)  ;;saves origUCS to return to
 (setq prevEn (entlast))
 (setq e (entsel "Select object to find centroid: "))
 (setq en (car e) ed (entget en) entype (cdr (assoc 0 ed)) obj (vlax-ename->vla-object en))

;; always return CENTRO in current UCS coordinates for transparent use

 (cond        
   ( (and (wcmatch entype "*POLYLINE")
          (polylineSelfCrossing en)
          )
     (vlr-beep-reaction)
     (princ "\nSelected polyline is self-crossing.")  ;; and exit
     (nil)  ;; so no point is returned
     )
     
   ( (and (eq entype "SPLINE")
          (safearray-value (variant-value (vla-intersectwith obj obj acExtendNone)))
          )
     (vlr-beep-reaction)
     (princ "\nSelected spline is self-crossing.")  ;; and exit
     (nil)  ;; so no point is returned
     )
     
   ( (eq entype "CIRCLE")
     (setq centro (osnap (cadr e) "_cen"))    
     )  

   ( (eq entype "3DSOLID")
     (setq centro (trans (vlax-get obj 'centroid) 0 1)) ;;current UCS coords
      )

   ( (eq entype "REGION")
     (setUCStoObject)
     (setq centro (trans (vlax-get obj 'centroid) 1 0))
     (vla-put-ActiveUCS acadDoc origUCS)
     (setq centro (trans centro 0 1))
     )

;;for others, have to set UCS to object, create a region, 
;;get its centroid, and then delete the region
   ( (and (member entype '("ELLIPSE" "LWPOLYLINE" "POLYLINE" "SPLINE"))
          (vlax-curve-isclosed obj)
          (vlax-curve-isplanar obj) ;;okay if a flat 3Dpolyline or spline
          (vlax-curve-getarea obj)
          )
     (setUCStoObject)
     (makeRegion obj)
     (setq newEn (entlast))
     (if (not (eq prevEn newEn))
         (progn
           (setq obj (vlax-ename->vla-object newEn))
           (setq centro (vlax-get obj 'centroid))
           (setq centro (trans centro 1 0)) ;; to WCS coords
           (entdel newEn)
           )
         (progn
           (vlr-beep-reaction)
           (princ "\nCould not derive centroid.")
           )
         )
     (vla-put-ActiveUCS acadDoc origUCS)
     (setq centro (trans centro 0 1)) ;;WCS -> orig UCS
     )

 ( T
   (vlr-beep-reaction)
   (princ "\nCould not derive centroid.")
   )

     );cond

 (if
   (type centro)
   (if (= 1 (getvar 'cmdactive))
       (progn  ;;return centro in UCS coordinates for transparent use
         (myerror "msg")
         (osnap centro "_none")
         )
       (progn  ;;convert centro to WCS coordinates to create entity
         (myerror "msg")
         (vla-addPoint *ModelSpace (vlax-3d-point (trans centro 1 0)))
         )
       )
     )
;;Note: no code after (if) so that returned point is last thing evaluated
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:SWC (/ _pac add ss i e temp it o a b pts tempC i3 ec)
 ;; Select Within/Crossing Curve
 ;; Alan J. Thompson, 03.31.11

 (vl-load-com)

 (defun _pac (e / l v d lst)
   (setq d (- (setq v (/ (setq l (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))) 100.))))
   (while (< (setq d (+ d v)) l)
     (setq lst (cons (vlax-curve-getPointAtDist e d) lst))
   )
 )

 (initget 0 "Crossing Within")
 (setq *SWC:Opt*
        (cond ((getkword (strcat "\nSpecify selection method witin curve [Crossing/Within] <"
                                 (cond (*SWC:Opt*)
                                       ((setq *SWC:Opt* "Crossing"))
                                 )
                                 ">: "
                         )
               )
              )
              (*SWC:Opt*)
        )
 )

 (princ "\nSelect closed curves to select object(s) within: ")
 (if (setq add (ssadd)
           ss  (ssget '((-4 . "<OR")
                        (0 . "CIRCLE,ELLIPSE")
                        (-4 . "<AND")
                        (0 . "*POLYLINE")
                        (-4 . "&=")
                        (70 . 1)
                        (-4 . "AND>")
                        (-4 . "OR>")
                       )
               )
     )
   (progn (repeat (setq i (sslength ss))
            (if (setq temp (ssget "_WP" (_pac (setq e (ssname ss (setq i (1- i)))))))
              (repeat (setq i2 (sslength temp)) (ssadd (ssname temp (setq i2 (1- i2))) add))
            )

            (if (eq *SWC:Opt* "Crossing")
              (progn (vla-getboundingbox (setq o (vlax-ename->vla-object e)) 'a 'b)
                     (setq pts (mapcar 'vlax-safearray->list (list a b)))
                     (if (setq tempC (ssget "_C"
                                            (list (caar pts) (cadar pts) 0.)
                                            (list (caadr pts) (cadadr pts) 0.)
                                     )
                         )
                       (repeat (setq i3 (sslength tempC))
                         (if (vlax-invoke
                               o
                               'Intersectwith
                               (vlax-ename->vla-object (setq ec (ssname tempC (setq i3 (1- i3)))))
                               acExtendNone
                             )
                           (ssadd ec add)
                         )
                       )
                     )
              )
            )
          )
          (sssetfirst nil add)
          (ssget "_I")
   )
 )
(command "copy")
(setvar "OSMODE" 111)
 (princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun C:RCC (/ echo wide high ptc ptll ptur scl)
 (if (and (setq scl (getvar "useri1"))
          (not (zerop scl))
          (setq ptc (getpoint "\nPick Center Of Rectangle : "))
     )
   (progn
     (setq echo (getvar 'CMDECHO))
     (setvar "cmdecho" 0)
     (command "_layer" "_m" "exasf" "_c" "3" """")
     (setq wide (* 0.0894 scl)
           high (* 0.08975 scl)
           hwide (/ wide 2.0)
           hhigh (/ high 2.0)
           ptll (list (- (car ptc) hwide) (- (cadr ptc) hhigh))
           ptur (list (+ (car ptll) wide) (+ (cadr ptll) high))
     )
     (setvar "plinewid" 0.0)
     (command ".PLINE" ptll "W" "0" "0" ".X" ptur ".Y" ptll ptur ".X" ptll ".Y" ptur "C")
     (setvar "cmdecho" echo)
   )
 )
 (princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:trigono  (/ pt1 pt2 dist ang lt2 lt3 sper tng)
(setq
pt1 (getpoint "\nselect pt1: ")
pt2 (getpoint "\nselect pt2: ")
pt3 (getpoint "\nselect pt3: ")
)
(command "_layer" "_m" "exasf" "_c" "3" """")
(command "_.PLINE" pt1 pt2 pt3 "_C")
(princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:test ()
(command "layer" "on" "A4" "")
(C:trigono)
(C:centroid)
(C:rcc)
(C:SWC)
;(command "_erase" (ssget "x" '((8 . "exasf"))))  <--- proglem here
;(command "layer" "off" "A4" "") <--- problem here
 )

 

When i add this two lines the lisp after swc not working correct

;(command "_erase" (ssget "x" '((8 . "exasf"))))

;(command "layer" "off" "A4" "")

 

Any ideas

 

Thanks

Link to comment
Share on other sites

When i add Dsl.lsp I have problem with SWC.lsp (works fine until "Specify selection method witin curve [Crossing/Within]" )

 

Can any one fix it ?

 

;| Centroid.lsp  - returns in current UCS coordinates the centroid of
  a selected object that can be in any UCS:
    - region
    - 3Dsolid
    - circle
    - ellipse
    - closed polyline (heavy)
    - closed LWpolyline
    - closed planar spline
    - closed planar 3Dpolyline

If used transparently, returns a point list to the calling command:
   Command: line
   Specify first point: 'CENTROID
   Select object to find centroid:     <<select object, line starts>>
   Specify next point or [undo]:       <<continue line>>

If not used transparently, creates a POINT object on the current layer.

In either case, coordinates of the most recently selected object are
saved in symbol CENTRO for later use.

Does not work with hatches, objects that cross themselves, or other
2D objects that cannot be turned into REGIONs.

If the current layer is locked or off, it is unlocked and turned on.

by Bill Gilliss
bill <at> realerthanreal <dot> com
Comments and suggestions always welcome.

Many thanks to 
 Kent Cooper for (PolylineSelfCrossing)
 gile for (Normal3Points)

No warranty, either expressed or implied, is made as to the fitness of
this information for any particular purpose.   All materials are to be
considered 'as-is' and use thereof should be considered as at your own
risk.

ver 1.0  Apr 14 2010 - initial public release
Check for updates at www.realerthanreal.com/autolisp

Keywords: AutoCAD AutoLISP centroid OSNAP transparent
======================================================================
|;

(defun c:centroid 
 (/ *delobj *osmode e en entype ed obj prevEn newEn myerror
   polylineSelfCrossing Normal3Points CrossProduct Normalize ScaleVector
   setUCStoObject ucsSave makeRegion acadObj acadDoc *Modelspace 
   newUCS origUCS objUCS lay layStatus )

 (vl-load-com)

;;=======subroutines========
 ;;  Function name: PSC = Polyline Self-Crossing
 ;;  To determine whether a Polyline of any type Crosses itSelf.
 ;;  With 3D Polylines, must have true intersection in 3D,
 ;;  not apparent in 2D.
 ;;  Returns T if self-crossing, nil if not.
 ;;  by Kent Cooper
 (defun polylineSelfCrossing (poly / pltyp plobj plverts plints)
   (vl-load-com)
   (setq
     pltyp (cdr (assoc 0 (entget poly)))
     plobj (vlax-ename->vla-object poly)
     plverts (length
               (safearray-value
                 (variant-value (vla-get-Coordinates plobj))))
     plints (/ (length
                 (safearray-value
                   (variant-value
                     (vla-intersectwith plobj plobj acExtendNone)))) 3)
   ); end setq
   (setq plverts (/ plverts (if (= pltyp "LWPOLYLINE") 2 3)))
   (if (vlax-curve-isClosed poly)
     (< plverts plints); then - closed
     (if (equal (vlax-curve-getStartPoint poly)
                (vlax-curve-getEndPoint poly) 1e-; else - open
       (<= plverts plints); then - start/end at same place
       (<= plverts (1+ plints)); else - open
     ); end if
   ); end if
 ); end defun



; Normal3Points (gile) Ret normal vector of a planeof 3 points
(DeFun Normal3Points (p0 p1 p2)
 (Normalize (CrossProduct (mapcar '- p1 p0) (mapcar '- p2 p0))) )

; CrossProduct (gile)  two vectors (real)
(DeFun CrossProduct (v1 v2)
 (list	(- (* (cadr v1) (caddr v2)) (* (caddr v1) (cadr v2)))
(- (* (caddr v1) (car v2)) (* (car v1) (caddr v2)))
(- (* (car v1) (cadr v2)) (* (cadr v1) (car v2)))  ) )

; Normalize (gile)  Return  single unit vector
(DeFun Normalize (v)
 ((lambda (l)  (if (/= 0 l)  (ScaleVector v (/ 1 l))  )  )
   (distance '(0 0 0) v)  ))

; ScaleVector (gile) vector after multiplying it by a scalar
(DeFun ScaleVector (v s) (mapcar (function (lambda (x) (* x s))) v))



(defun ucsSave ( / allUCS newUCS)  ;;be sure current UCS has a name to return to
 (setq allUCS (vla-get-UserCoordinateSystems acaddoc))
 (setq origUCS
   (vla-add allUCS
 		(vlax-3d-point (trans '(0.0 0.0 0.0) 1 0))
 		(vlax-3d-point (trans '(1.0 0.0 0.0) 1 0))
 		(vlax-3d-point (trans '(0.0 1.0 0.0) 1 0))
 		"zz_centroid_01"
  )
 )
)

(defun setUCStoObject ( / allUCS newUCS)
 (setq pt (osnap (cadr e) "_near"))
 (setq newOrig (trans pt 1 0)) ;;pick point in WCS
 (if (or
       (eq entype "SPLINE")
       (and (eq entype "POLYLINE")(= 8 (logand 8 (cdr (assoc 70 ed)))))  ;;3Dpolyline
       )
     (progn
       (setq pt1 (vlax-curve-getPointatParam obj 1))
       (setq pt2 (vlax-curve-getPointatParam obj 2))
       (setq pt3 (vlax-curve-getPointatParam obj 3))
       (setq normal (Normal3Points pt1 pt2 pt3))
       )
     (setq normal (vlax-get obj 'Normal))
     )
 (setq allUCS (vla-get-UserCoordinateSystems acaddoc))
 (setq newUCS 
   (vla-add allUCS 
     (vlax-3D-point (trans '(0.0 0.0 0.0) normal 0))
     (vlax-3D-point (trans '(1.0 0.0 0.0) normal 0))
     (vlax-3d-point (trans '(0.0 1.0 0.0) normal 0)) 
     "zz_centroid_02"
     )
   )
;;move UCS origin to point picked on object   
 (vla-put-origin newUCS (vlax-3d-point newOrig 0 1))
 (vla-put-activeUCS acadDoc newUCS)  ;;update UCS
 )


(defun makeRegion ( entity / sa reg)
 (setq sa (vlax-make-variant
             (vlax-safearray-fill
               (vlax-make-safearray vlax-vbObject '(0 . 0))
                 (list entity)
                 )
               )
       reg (vla-addregion
             (vla-get-ModelSpace
               (vla-get-ActiveDocument
                 (vlax-get-acad-object)
                 )
               )
             sa
             )
       )
 )


;;=======main program========

 (defun myerror (msg)
   (setvar 'delobj *delobj)
   (setvar 'osmode *osmode)
   (if origUCS (vla-put-ActiveUCS acadDoc origUCS))
   (setq *error* olderror)
   )

 (setq olderror *error*)
 (setq *error* myerror)
 (setq *delobj (getvar 'delobj))
 (setvar 'delobj 0)
 (setq *osmode (getvar 'osmode))
 (setvar 'osmode 0)
 
 
;;be sure current layer is unlocked  
 (setq lay (entget (tblobjname "layer" (getvar 'clayer))))
 (setq laystatus (cdr (assoc 70 lay)))
 (if (= 4 (logand 4 laystatus))
     (progn
      (setq newLaystatus (cons 70 (- layStatus 4)))
      (setq lay (subst (cons 70 (- layStatus 4)) (assoc 70 lay) lay))
      (entmod lay)
      (entupd (cdr (assoc -1 lay)))
      )
     )  
;;and turned on  
 (setq lay (entget (tblobjname "layer" (getvar 'clayer))))
 (setq laystatus (cdr (assoc 62 lay)))
 (if (minusp laystatus)
     (progn
      (setq lay (subst (cons 62 (abs laystatus)) (assoc 62 lay) lay))
      (entmod lay)
      (entupd (cdr (assoc -1 lay)))
      )
     )  

;;be sure points show up when created
 (if (and
       (= 0 (getvar 'pdmode)) 
       (= 0 (getvar 'cmdactive))
       )
     (progn
       (setvar 'pdmode 34)
       (setvar 'pdsize 0)
       )
     )


 (setq acadObj (vlax-get-acad-object))
 (setq acadDoc (vla-get-activedocument acadObj))
 (setq *ModelSpace (vla-get-ModelSpace acadDoc))
 (ucsSave)  ;;saves origUCS to return to
 (setq prevEn (entlast))
 (setq e (entsel "Select object to find centroid: "))
 (setq en (car e) ed (entget en) entype (cdr (assoc 0 ed)) obj (vlax-ename->vla-object en))

;; always return CENTRO in current UCS coordinates for transparent use

 (cond        
   ( (and (wcmatch entype "*POLYLINE")
          (polylineSelfCrossing en)
          )
     (vlr-beep-reaction)
     (princ "\nSelected polyline is self-crossing.")  ;; and exit
     (nil)  ;; so no point is returned
     )
     
   ( (and (eq entype "SPLINE")
          (safearray-value (variant-value (vla-intersectwith obj obj acExtendNone)))
          )
     (vlr-beep-reaction)
     (princ "\nSelected spline is self-crossing.")  ;; and exit
     (nil)  ;; so no point is returned
     )
     
   ( (eq entype "CIRCLE")
     (setq centro (osnap (cadr e) "_cen"))    
     )  

   ( (eq entype "3DSOLID")
     (setq centro (trans (vlax-get obj 'centroid) 0 1)) ;;current UCS coords
      )

   ( (eq entype "REGION")
     (setUCStoObject)
     (setq centro (trans (vlax-get obj 'centroid) 1 0))
     (vla-put-ActiveUCS acadDoc origUCS)
     (setq centro (trans centro 0 1))
     )

;;for others, have to set UCS to object, create a region, 
;;get its centroid, and then delete the region
   ( (and (member entype '("ELLIPSE" "LWPOLYLINE" "POLYLINE" "SPLINE"))
          (vlax-curve-isclosed obj)
          (vlax-curve-isplanar obj) ;;okay if a flat 3Dpolyline or spline
          (vlax-curve-getarea obj)
          )
     (setUCStoObject)
     (makeRegion obj)
     (setq newEn (entlast))
     (if (not (eq prevEn newEn))
         (progn
           (setq obj (vlax-ename->vla-object newEn))
           (setq centro (vlax-get obj 'centroid))
           (setq centro (trans centro 1 0)) ;; to WCS coords
           (entdel newEn)
           )
         (progn
           (vlr-beep-reaction)
           (princ "\nCould not derive centroid.")
           )
         )
     (vla-put-ActiveUCS acadDoc origUCS)
     (setq centro (trans centro 0 1)) ;;WCS -> orig UCS
     )

 ( T
   (vlr-beep-reaction)
   (princ "\nCould not derive centroid.")
   )

     );cond

 (if
   (type centro)
   (if (= 1 (getvar 'cmdactive))
       (progn  ;;return centro in UCS coordinates for transparent use
         (myerror "msg")
         (osnap centro "_none")
         )
       (progn  ;;convert centro to WCS coordinates to create entity
         (myerror "msg")
         (vla-addPoint *ModelSpace (vlax-3d-point (trans centro 1 0)))
         )
       )
     )
;;Note: no code after (if) so that returned point is last thing evaluated
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:SWC (/ _pac add ss i e temp it o a b pts tempC i3 ec)
 ;; Select Within/Crossing Curve
 ;; Alan J. Thompson, 03.31.11

 (vl-load-com)

 (defun _pac (e / l v d lst)
   (setq d (- (setq v (/ (setq l (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))) 100.))))
   (while (< (setq d (+ d v)) l)
     (setq lst (cons (vlax-curve-getPointAtDist e d) lst))
   )
 )

 (initget 0 "Crossing Within")
 (setq *SWC:Opt*
        (cond ((getkword (strcat "\nSpecify selection method witin curve [Crossing/Within] <"
                                 (cond (*SWC:Opt*)
                                       ((setq *SWC:Opt* "Crossing"))
                                 )
                                 ">: "
                         )
               )
              )
              (*SWC:Opt*)
        )
 )

 (princ "\nSelect closed curves to select object(s) within: ")
 (if (setq add (ssadd)
           ss  (ssget '((-4 . "<OR")
                        (0 . "CIRCLE,ELLIPSE")
                        (-4 . "<AND")
                        (0 . "*POLYLINE")
                        (-4 . "&=")
                        (70 . 1)
                        (-4 . "AND>")
                        (-4 . "OR>")
                       )
               )
     )
   (progn (repeat (setq i (sslength ss))
            (if (setq temp (ssget "_WP" (_pac (setq e (ssname ss (setq i (1- i)))))))
              (repeat (setq i2 (sslength temp)) (ssadd (ssname temp (setq i2 (1- i2))) add))
            )

            (if (eq *SWC:Opt* "Crossing")
              (progn (vla-getboundingbox (setq o (vlax-ename->vla-object e)) 'a 'b)
                     (setq pts (mapcar 'vlax-safearray->list (list a b)))
                     (if (setq tempC (ssget "_C"
                                            (list (caar pts) (cadar pts) 0.)
                                            (list (caadr pts) (cadadr pts) 0.)
                                     )
                         )
                       (repeat (setq i3 (sslength tempC))
                         (if (vlax-invoke
                               o
                               'Intersectwith
                               (vlax-ename->vla-object (setq ec (ssname tempC (setq i3 (1- i3)))))
                               acExtendNone
                             )
                           (ssadd ec add)
                         )
                       )
                     )
              )
            )
          )
          (sssetfirst nil add)
          (ssget "_I")
   )
 )
(command "copy")
 (princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun C:RCC (/ echo wide high ptc ptll ptur scl)
 (if (and (setq scl (getvar "useri1"))
          (not (zerop scl))
          (setq ptc (getpoint "\nPick Center Of Rectangle : "))
     )
   (progn
     (setq echo (getvar 'CMDECHO))
     (setvar "cmdecho" 0)
     (command "_layer" "_m" "exasf" "_c" "3" """")
     (setq wide (* 0.0894 scl)
           high (* 0.08975 scl)
           hwide (/ wide 2.0)
           hhigh (/ high 2.0)
           ptll (list (- (car ptc) hwide) (- (cadr ptc) hhigh))
           ptur (list (+ (car ptll) wide) (+ (cadr ptll) high))
     )
     (setvar "plinewid" 0.0)
     (command ".PLINE" ptll "W" "0" "0" ".X" ptur ".Y" ptll ptur ".X" ptll ".Y" ptur "C")
     (setvar "cmdecho" echo)
   )
 )
 (princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:trigono  (/ pt1 pt2 dist ang lt2 lt3 sper tng)
(setq
pt1 (getpoint "\nselect pt1: ")
pt2 (getpoint "\nselect pt2: ")
pt3 (getpoint "\nselect pt3: ")
)
(command "_layer" "_m" "exasf" "_c" "3" """")
(command "_.PLINE" pt1 pt2 pt3 "_C")
(princ)
)

;;;;;;;;;;;;;;;;;;;;delete layer ;;;;;;;;;;;;;;;;;

(defun c:DSL()
(command "_.Undo" "M")
(setq selEnt(car (entsel "\nSelect the Entity for Layer :")))
(if (/= selEnt nil)
	(progn
		(setq entLay(cdr (assoc 8 (entget selEnt))))
		(setq entSet(ssget "X" (List (Cons 8 entLay))))
		(If (/= entset nil)
			(progn
				(command "._Erase" entset "")
			)
			(progn
				(alert "\nNothing Selected for deletion:")
			)
		)
	)
	(progn
		(princ "\nYou have not selected any entity for layer!")
	)
)
 	(princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:test ()
(C:trigono)
(C:centroid)
(C:rcc)
(C:SWC)
(c:DSL) ;<-- i want to delete layer "exasf" after copy 
 )

 

Is any other better way to write this :

 

(defun c:test ()
(C:trigono)
(C:centroid)
(C:rcc)
(C:SWC)
(c:DSL) ;<-- i want to delete layer "exasf" after copy 
 )

 

Thanks

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...