Jump to content

Revision Cloud with Hatch and Leader lisp need help


shailujp

Recommended Posts

Hi to all,

 

So, this is my lisp. It does the following:

1) Adds revision clouds to multiple entities

2) Adds Layer (or create if required and add properties)

3) Adds hatch

4) Inserts a block for leader and text (already formated)

 

I have very limited knowledge of the lisp. As you can see I have copied few different codes and combined it to make it work for my application. It works but I know this is not systematic at all. I dont know if my error handeling is correct.

 

One thing that I wish to add is if the revision cloud is too big or too small, it should allow to do that without closing and undoing everything. In other sense, I need undo and reset arc length option in this. Can someone help me on this please?

 

 

 
(defun c:RVC6 (/ *error* oce mflag ans)
;************************************Error handling*********************************************
  (defun *error* (msg)
    (setvar "cmdecho" OCE)
    (setq *error* nil)
    (princ "\nRevision cloud program is done.")
    (princ)
  )
;************************************Program begins*********************************************
  (setq OCE (getvar "cmdecho")
        OOS (getvar "osmode")
   )
  (setvar "cmdecho" 0)

  (setq mflag nil)
  (while (not mflag)
    (prompt "\n***    Enter option C, H, L, or E    ***")
    (initget 0 "Cloud Hatch Leader Exit")
    (setq Ans (getkword "\nconvert to revision Cloud/Hatch/Leader/<Exit>: "))
    (if (= Ans nil)
        (setq Ans "Exit")
      ) ;end if
    (cond 
        (  (= Ans "Cloud")
           (convcloud)
        )
        (  (= Ans "Hatch")
           (Addhatch)
        )
        (  (= Ans "Leader")
           (Addleader)
        )
        (  (= Ans "Exit")
           (setvar "cmdecho" OCE)
           (setvar "osmode" OOS)
           (quit)
        )
     ) ;end cond
  );end while 
);end defun
;************************************Program ends**********************************************

;*******************************Start of "convcloud" program***********************************
(defun convcloud (/ al ss)
        (initget (+ 2 4))
        (setq al (getreal "Specify Arc length <0.5>:"))
        (if (= al nil) ;If user do not input a value here
            (setq al 0.5) ;Consider "Enter" as 0.5
         ) ; end if
        (if (setq ss (ssget '((0 . "LINE,*POLYLINE,CIRCLE,ELLIPSE,SPLINE,ARC"))))
            (progn
 (repeat (setq i (sslength ss))
                 (command "_.revcloud" "a" al al "" (ssname ss (setq i (1- i))) "")
          (if
    (not (tblsearch "LAYER" "CONSTRUCTION"))
    (command "-layer" "N" "CONSTRUCTION" "C" "1" "CONSTRUCTION" "LT" "continuous" "CONSTRUCTION" "")
    ) ; end if
          (command ".-layer" "S" "CONSTRUCTION" "C" "red" "" "")  
             (Command "Chprop" "l" "" "la" "CONSTRUCTION" "C" "BYLAYER" "Lt" "BYLAYER" "LW" "BYLAYER" "")
                );end repeat
              (princ "\nRevision cloud(s) created on CONSTRUCTION layer.")
             );end progn
           (princ "\nNo objects selected.")
)
);end defun
;*******************************End of "convcloud" program*************************************

;*****************************Start of "Addhatch" Program *************************************
(defun Addhatch (/ htype selset thisobj setlen entname)
     
        (initget 1 "D R")
        (setq htype (getkword "\nSpecify hatch type? Demo(D)/Rebuild(R):"))
 
        (if (= htype "D")
            (setq htype "ANSI31")
          ) ;end if
   
        (if (= htype "R")
            (setq htype "DOTS")
          ) ;end if
        (princ "\nSelect object(s) to hatch:")
        (setq selset (ssget))
       (if selset
         (progn
           (setq thisobj 0)
           (setq setlen (sslength selset))
           (while (< thisobj setlen )
              (setq entname(ssname selset thisobj))
              (Command "-bhatch" "Advanced" "Style" "Outer" "" "")
              (command "-bhatch" "p" htype "3" "" "s" entname "" "")
       (if
  (not (tblsearch "LAYER" "CONSTRUCTION"))
  (command "-layer" "N" "CONSTRUCTION" "C" "1" "CONSTRUCTION" "LT" "continuous" "CONSTRUCTION" "")
 ) ; end if
       (command ".-layer" "S" "CONSTRUCTION" "C" "red" "" "")
              (Command "Chprop" "l" "" "la" "CONSTRUCTION" "C" "BYLAYER" "Lt" "BYLAYER" "LW" "BYLAYER" "")
              (setq thisobj(+ thisobj 1))
            ) ; end while
 (alert "\n ***WARNING*** 
Hatching could not skip the inner objects.
To solve this, Double click hatch and `Add: select objects'
and select inner object & click OK")
          ) ; end progn
        ) ;end if selset
        (princ "\nNo objects selected.")
);end defun
;*******************************End of "Addhatch" program*************************************

;*****************************Start of "Addleader" Program ***********************************
(defun Addleader (/ pt1)
         (while
            (setq pt1 (getpoint "\nInserting task description note, Specify Arrow End Point or hit Enter to close:"))
     (Command "_INSERT" "CP TEXT" pt1 "" "" "")
       (command "explode" "l")
          );end while
);end defun

Link to comment
Share on other sites

  • 2 weeks later...

Can someone please help me on just this one?

 

One thing that I wish to add is if the revision cloud is too big or too small, it should allow to do that without closing and undoing everything. In other sense, I need undo and reset arc length option in this. Can someone help me on this please?

 

Thanks in advance

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...