Jump to content

Planting Annotation Lisp


manohar

Recommended Posts

Dear Lisp Experts,

 

Currently i am doing planting annotation manually, which involves list area of polyline, multiply the area with density of plants in a sqm, then place leader and text with calculated qty and plant name near the polyline.

I don't know how to write lisp, if anyone have spare time, please help me a lisp to do the following:

 

At first instance of command in a drawing , lisp to invoke the user to select drawing unit either M or MM.

 

1. Select Plant name text exist in the Drawing.

2. Select polyline (Planting area) and list its area (If drawing unit is in MM divide the area by 1,000,000 to convert the area to Sq.m)

3. Ask for Density of Planting

4. Multiply entered density and listed area

5. Round off the Result to nearest full number.

6. Place leader with three points at user picked location and place single line text (with Current Text and Dimension style) with Calculated Qty followed by a space and then Selected plant name.

7. Continue with same name of planting for the other areas untill operation is cancelled.

 

 

Thanks in advance.

Manohar.

Edited by manohar
Spell Check & More Details Added
Link to comment
Share on other sites

Sounds like a good task to write your 1st lisp, just read some of the posts in the lisp section for code, we all started at some point

 

hints

getstring

entsel

getreal

* entsel getreal

fix

getpoint

getpoint

getpoint

command leader

 

wrap all above in while

Link to comment
Share on other sites

Sounds like a good task to write your 1st lisp, just read some of the posts in the lisp section for code, we all started at some point

 

 

Thanks Bigal for your Motivation and Hints..

 

This is what i came up with Bigal's hints and most of copy paste from various codes.

it is stopped with ; error: bad argument type: numberp: nil

reason being not coded correctly and not finished. Please help me.

 

Also code is currently asking to enter the plant name which i want to have either user to enter or select existing text string, but i don't know what to do.

 

(defun c:plabel (/ plantname pldens endata e a b entype newtxt P1 P2 P3 )
 ;; store and set system variables
 (setq osmode (getvar "osmode")
cmdecho (getvar "cmdecho")
); setq
 (and  (null unit)    ;<-- will only ask you once
(not (initget "M MM"))
(setq unit (cadr (assoc (getkword  "\nChoos units to use [M/MM]: ") '(("M" 1.0)("MM" 0.000001))))))
 (setvar "osmode" 0)
(setvar "cmdecho" 0)
 (while 
   (getstring plantname "\nEnter the Plant Name: ")
   (getstring pldens "\nEnter Density of Planting: ")
;; get polyline from user selection
(setq pline (car (entsel "\nSelect Planting Boundary: ")))
;; get the area, do the math
(command ".area" "e" pline)
(setq area (getvar "area"))
(setq b (* area pldens))
(setq a (* b unit))
(setq a (rtos a 2 0))
(setq newtxt (strcat a " " PlantName))
(setvar "cmdecho" 1)
(princ NewText)
(setvar "cmdecho" 0)
(COMMAND "OSNAP" "OFF")
(setq p1 (getpoint"\nLeader start point: "))
(setq p2 (getpoint P1"\nLeader Second point: "))
(setq p3 (getpoint P2"\nLeader end point: "))
(COMMAND "LEADER" p1 p2 p3 "")
(COMMAND "TEXT" "M" P3 "" newtxt)
(princ)
)
)

Edited by manohar
Link to comment
Share on other sites

Post a sample drawing of "before" and "after", that way we can give a better suggestions manohar.

 

Please find attached.

Text marked in blue color is for explaining my requirement.

Red color polyline & texts in the legend are existing.

PLABEL.dwg

Link to comment
Share on other sites

Also code is currently asking to enter the plant name which i want to have either user to enter or select existing text string, but i don't know what to do.

 

SelectionOrText by LM

 

As for the posted code, you can replace these lines...

 

(getstring plantname "\nEnter the Plant Name: ")
(getstring pldens "\nEnter Density of Planting: ")

 

with what you would pick up from the link i posted above

 

HTH

Link to comment
Share on other sites

hang on...

 

That error is brought about by multiplying the area value with a nil value. On your code pldens is not defined

 

(getstring pldens "\nEnter Density of Planting: ")

 

Should have been

(setq pldens (getstring  "\nEnter Density of Planting: "))

 

but then again. value from that will give you a "string" value . use getint or getreal depending on your needs

 

(setq pldens (getreal "\nEnter Density of Planting: "))

Edited by pBe
Link to comment
Share on other sites

Just some suggestions, Dont use reserved words can cause problems.

 

If you load into VLIDE and Tools Load, under Debug is Last break source should at least show where it stopped.

 

(setq osmode (getvar "osmode")
cmdecho (getvar "cmdecho")
)

(setq oldsnap (getvar "osmode")
oldecho (getvar "cmdecho")
)

(setq pline 
(setq obj 

(setq area
(setq objarea

; suggest use osmode for snaps easier to set to any combo you want just Osnap then type Osmode will see snap settings number
;I group all the current settings at start also back to default last
(COMMAND "OSNAP" "OFF")
(setvar "osmode" 0)

; mixing reals and strings may cause an error 
(setq a (rtos a 2 0))
(setq ans (rtos a 2 0))

 

If you load into VLIDE and Tools Load, under Debug is Last break source should at least show where it stopped.

Link to comment
Share on other sites

Try this and let me know if this serves your needs .

 

(defun c:Plant (/ *error* d id f _strings 1p 2p i sn ss spc r txt)
 (or doc (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))))
 ;;                    ;;
 ;;    Author : Tharwat Al Shoufi    ;;
 ;;    Date: 21. August. 2014        ;;
 ;;                    ;;
 (defun *error* (msg / del)
   (if (and d (setq d (findfile d)))
     (vl-file-delete d)
   )
   (if (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")
     (princ (strcat "\n ** Error : " msg " **"))
   )
 )
 ;;                                        ;;
 (cond
   ((and (setq d (vl-filename-mktemp nil nil ".dcl")) (setq f (open d "w")))
    (progn
      (write-line
        (strcat
          "test : dialog { label = \"Planting Annotation \"; fixed_height = true; width = 40; fixed_width = true;"
          ": text { label = \"Author : Tharwat Al Shoufi \" ; alignment = centered;}" "spacer;" ": boxed_column {"
          ": row { : text {label = \"Text\";} : popup_list { key = \"str\"; width = 20; fixed_width = true;}}"
          ": row { : text {label = \"Units\";} : edit_box { key = \"unit\"; width = 20; fixed_width = true;}}"
          ": row { : text { label = \"Density\"; } : edit_box { key = \"den\"; width = 20; fixed_width = true;}}"
          ": row { : text { label = \"Text Height :\";} : edit_box { key = \"hgt\"; width = 20; fixed_width = true;}}}"
          "spacer_1;"
          ": row { : button { label = \"Okay \"; key = \"oki\"; width = 14; is_default = true ;}
           : button { label = \"Exit\"; key = \"esc\"; width = 14; is_cancel  = true ; }}}"
         )
        f
      )
      (close f)
    )
   )
   (t (alert "Can't load the temporary file <!>"))
 )
 (if (or (not d) (not (new_dialog "test" (setq id (load_dialog d)))))
   (progn (if (>= id 0)
            (unload_dialog id)
          )
          (if (and d (setq d (findfile d)))
            (vl-file-delete d)
          )
   )
   (progn (setq _strings '("SH/CLER.I" "SH/GARD.J" "SH/JASM.S" "SH/CARI.G" "GC/SETC.P" "GC/RUEL.C" "GC/JACQ.C" "H/CLER.I"))
          (start_list "str")
          (mapcar 'add_list _strings)
          (end_list)
          (if *Planting*
            (mapcar 'set_tile (list "str" "unit" "den" "hgt") *Planting*)
            (set_tile "unit" "1000000")
          )
          (action_tile
            "oki"
            "(setq *Planting* (mapcar 'get_tile (list \"str\" \"unit\" \"den\" \"hgt\"))) (done_dialog)"
          )
          (action_tile "esc" "(done_dialog)")
          (start_dialog)
          (unload_dialog id)
          (vl-file-delete d)
   )
 )
 (if *Planting*
   (cond ((not (numberp (read (cadr *Planting*)))) (alert "Unit value must be number(s) ONLY !"))
         ((not (numberp (read (caddr *Planting*)))) (alert "Density value must be number(s) ONLY !"))
         ((not (numberp (read (nth 3 *Planting*)))) (alert "Text Height must be number(s) ONLY !"))
         ((and (princ "\n Select Closed objects :") (setq ss (ssget '((0 . "CIRCLE,ELLIPSE,LWPOLYLINE")))))
          (setq spc (vlax-get-property
                      doc
                      (if (eq (getvar 'TILEMODE) 1)
                        'Modelspace
                        'PaperSpace
                      )
                    )
          )
          (vla-startUndomark doc)
          (repeat (setq i (sslength ss))
            (setq sn (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
            (if (wcmatch (vla-get-objectname sn) "AcDb*line")
              (progn (setq 1p (vlax-get (setq r (car (vlax-invoke spc 'addregion (list sn)))) 'centroid))
                     (vla-delete r)
              )
              (setq 1p (vlax-get sn 'center))
            )
            (setq 2p (polar 1p (* pi 0.25) (* 15. (atof (nth 3 *Planting*)))))
            (setq txt (vlax-invoke
                        spc
                        'addmtext
                        (trans 2p 1 0)
                        0.0
                        (strcat (rtos (* (/ (vla-get-area sn) (atof (cadr *Planting*))) (atof (caddr *Planting*))) 2 0)
                                " "
                                (nth (atoi (car *Planting*)) _strings)
                        )
                      )
            )
            (vla-put-height txt (nth 3 *Planting*))
            (vlax-invoke spc 'addleader (append (trans 1p 1 0) (trans 2p 1 0)) txt aclinewitharrow)
          )
          (vla-endundomark doc)
         )
         (t (princ "\n Exit without any action !"))
   )
 )
 (princ)
)(vl-load-com)

Link to comment
Share on other sites

Try this and let me know if this serves your needs .

 

(defun c:Plant (..

 

Thats nice and all tharwat, but we were aiming to let the OP figure it out on his own.

 

At any rate, we hope the OP will learn form your post.

Link to comment
Share on other sites

Thats nice and all tharwat, but we were aiming to let the OP figure it out on his own.

 

At any rate, we hope the OP will learn form your post.

 

Thank you pBe .

 

I hope that I was misunderstood with my codes in your following up thread . :)

The OP PM me to help him , so I wrote it on their demand and nothing's more .

 

Regards.

Link to comment
Share on other sites

Thank you pBe .

 

I hope that I was misunderstood with my codes in your following up thread . :)

The OP PM me to help him , so I wrote it on their demand and nothing's more .

 

Regards.

 

 

Thank you Tharwat for responding my PM. I have not tested it.

 

Thanks pBe, it is my first lisp, i dont think i can learn lisp and write of my own during this short time. I will try to learn as early as possible.

Edited by manohar
Link to comment
Share on other sites

Thank you Tharwat for responding my PM. I have not tested it.

 

You're welcome , just let me know after you have the time to test the routine .

 

Good luck .

Link to comment
Share on other sites

Awesome, as always from Tharwat. it doesn't get better than this..

 

Thanks a lot:D:thumbsup:

 

Waw excellent , you are very welcome and I am glad to help :)

 

Note: The routine gives the opportunity to select many objects with one shot .

* You can add more texts from your LEGEND to the routine and you can recognize that with a little search among the codes ( just ask if you couldn't )

 

Regards.

Link to comment
Share on other sites

The OP PM me to help him , so I wrote it on their demand and nothing's more .

 

Since you put it that way then proceed as requested :lol: Carry on.

 

Cheers dude.

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