Jump to content

Recommended Posts

Posted

how I can apply this lisp ?

  • Replies 38
  • Created
  • Last Reply

Top Posters In This Topic

  • gadgetjay

    16

  • BIGAL

    6

  • ronjonp

    6

  • hanhphuc

    4

Top Posters In This Topic

Posted Images

Posted
it was a decimal error as some of the stands had .5s - no biggy!

 

Good to hear. Here is some code that should fix the wrong offset direction and precision error.

(defun c:foo (/ lm:listclockwise-p lm:makereadable _colinear a b cw d out p pp s th)
 ;; RJP 05.03.2018
 ;; Labels exterior edges of 'stands' with edge length
 (defun _colinear (p1 p2 p3 f) (equal (+ (distance p1 p2) (distance p2 p3)) (distance p1 p3) f))
 ;; Make Readable  -  Lee Mac
 ;; Returns a given angle corrected for text readability
 (defun lm:makereadable (a)
   ((lambda (a)
      (if (and (< (* pi 0.5) a) (<= a (* pi 1.5)))
 (+ a pi)
 a
      )
    )
     (rem (+ a pi pi) (+ pi pi))
   )
 )
 ;; List Clockwise-p - Lee Mac
 ;; Returns T if the point list is clockwise oriented
 (defun lm:listclockwise-p (lst)
   (minusp (apply '+
	   (mapcar (function (lambda (a b) (- (* (car b) (cadr a)) (* (car a) (cadr b)))))
		   lst
		   (cons (last lst) lst)
	   )
    )
   )
 )
 (cond
   ((setq s (ssget '((0 . "lwpolyline") (8 . "BoothOutline"))))
    (setq th 500)
    (foreach pl (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (setq p (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget pl))))
      (setq p
      (mapcar '(lambda (a b)
		 (list (polar a (angle a b) (* 0.5 (setq d (distance a b)))) a b (angle a b) d)
	       )
	      p
	      (append (cdr p) (list (car p)))
      )
      )
      (setq cw (lm:listclockwise-p (mapcar 'car p)))
      (setq out (cons (mapcar '(lambda	(x) (append x (list (if cw + -)))) p) out))
    )
    (foreach pt (setq out (apply 'append out))
      (and
 (null (vl-remove-if-not
	 '(lambda (x)
	    (or (equal (car pt) (car x) 1e-1) (_colinear (cadr x) (car pt) (caddr x) 1e-1))
	  )
	 (vl-remove pt out)
       )
 )
 (setq pp (polar (car pt) ((last pt) (cadddr pt) (/ pi 2.)) th))
 (entmakex
   (list
     '(0 . "TEXT")
     '(100 . "AcDbEntity")
     '(8 . "BoothOutlineLength")
     '(100 . "AcDbText")
     (cons 10 pp)
     (cons 40 th)
     '(62 . 1)
     (cons 1
	   (vl-string-right-trim
	     "."
	     (vl-string-right-trim "0" (vl-princ-to-string (/ (cadr (reverse pt)) 1000.)))
	   )
     )
     (cons 50 (lm:makereadable (cadddr pt)))
     '(72 . 1)
     (cons 11 pp)
     '(100 . "AcDbText")
     '(73 . 2)
   )
 )
      )
    )
   )
 )
 (princ)
)
(vl-load-com)

2018-05-08_7-34-19.jpg

Posted

I tried to post a replys yesterday but error 500 killed me!

Ronjonp this code will save me some much time i cant thankyou enough :notworthy:.

i have tried it on a few plans and if anything it works to good!

I get a few drawings where a stand is drawn 2.99 (2999) instead of 3 (3000) so is there a way of adding LEEMACs Round off code?

 

[b]Round to the Nearest Multiple[/b]

;; Round Multiple  -  Lee Mac ;; Rounds 'n' to the nearest multiple of 'm'  
(defun LM:roundm ( n m )
(* m (fix ((if (minusp n) - +) (/ n (float m)) 0.5))) )     
            
[b][i]Alternative Version[/i][/b]

;; Round Multiple  -  Lee Mac ;; Rounds 'n' to the nearest multiple of 'm'
(defun LM:roundm ( n m )     
(* m (atoi (rtos (/ n (float m)) 2 0))) )                  

Posted (edited)

What are you going to do with all that free time? ;)

 

To use Lee's round code:

;; Change this
(cons 1
     (vl-string-right-trim
"."
(vl-string-right-trim "0" (vl-princ-to-string (/ (cadr (reverse pt)) 1000.)))
     )
)
;; To to this ( you have to include the subfunction 'lm:roundm' within the code too )
(cons 1 (itoa (lm:roundm (/ (cadr (reverse pt)) 1000.) 1)))

Edited by ronjonp
Posted

Thanks Ronjonp, i'll give that a go...

My 'new' free time will be redrawing 40mb / 400 layer venue drawings down to 0.5mb /10 layer drawings.. :roll: and of course dimensioning the aisles between the stands - unless you want to write a scipt for that too !!!

Posted

How many aisles dims ? if you just want a few then its easy doing a manual pick inside, pick inside next, dim is drawn say at mid of 1st rectang to the other with a perp distance, automating may have a problem of how you really want the result to look with a over dimensioning result. Before any one has a go perhaps clarify.

 

with a bit of padding
ssget f
line
instersectwith obj1
closestptto obj2
dim pt1 pt2

Posted
How many aisles dims ? if you just want a few then its easy doing a manual pick inside, pick inside next, dim is drawn say at mid of 1st rectang to the other with a perp distance, automating may have a problem of how you really want the result to look with a over dimensioning result. Before any one has a go perhaps clarify.

 

with a bit of padding
ssget f
line
instersectwith obj1
closestptto obj2
dim pt1 pt2

 

 

sent you a PM

Posted

i think i broke it!:ouch:

; error: bad DXF group: (1.13)

 

 

(defun c:foo (/ lm:listclockwise-p lm:makereadable _colinear a b cw d out p pp s th)

 ;; RJP 05.03.2018
 ;; Labels exterior edges of 'stands' with edge length
 (defun _colinear (p1 p2 p3 f) (equal (+ (distance p1 p2) (distance p2 p3)) (distance p1 p3) f))


[color=red]  ;; Round Multiple  -  Lee Mac ;; Rounds 'n' to the nearest multiple of 'm'  
 (defun LM:roundm ( n m )
 (* m (atoi (rtos (/ n (float m)) 2 0))) ) [/color]  

 ;; Make Readable  -  Lee Mac
 ;; Returns a given angle corrected for text readability
 (defun lm:makereadable (a)
   ((lambda (a)
      (if (and (< (* pi 0.5) a) (<= a (* pi 1.5)))
    (+ a pi) a ))(rem (+ a pi pi) (+ pi pi))))
  

 ;; List Clockwise-p - Lee Mac
 ;; Returns T if the point list is clockwise oriented
 (defun lm:listclockwise-p (lst)
   (minusp (apply '+
          (mapcar (function (lambda (a b) (- (* (car b) (cadr a)) (* (car a) (cadr b)))))
              lst
              (cons (last lst) lst)))))


          
 (cond
   ((setq s ([color=red]ssget "_x"'[/color]((0 . "lwpolyline") (8 . "BoothOutline"))))
    (setq th 500)
    (foreach pl (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (setq p (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget pl))))
      (setq p
         (mapcar '(lambda (a b)
            (list (polar a (angle a b) (* 0.5 (setq d (distance a b)))) a b (angle a b) d)) p
             (append (cdr p) (list (car p)))))
      (setq cw (lm:listclockwise-p (mapcar 'car p)))
      (setq out (cons (mapcar '(lambda    (x) (append x (list (if cw + -)))) p) out)))
    (foreach pt (setq out (apply 'append out))
      (and
    (null (vl-remove-if-not
        '(lambda (x)
           (or (equal (car pt) (car x) 1e-1) (_colinear (cadr x) (car pt) (caddr x) 1e-1)))(vl-remove pt out)))
    (setq pp (polar (car pt) ((last pt) (cadddr pt) (/ pi 2.)) th))
    (entmakex
      (list
        '(0 . "TEXT")
        '(100 . "AcDbEntity")
        '(8 . "BoothOutlineLength")
        '(100 . "AcDbText")
        (cons 10 pp)
        (cons 40 th)
        '(62 . 1)
            [color=red](cons 1 (lm:roundm (/ (cadr (reverse pt)) 1000.) 1))[/color]
        (cons 50 (lm:makereadable (cadddr pt)))
        '(72 . 1)
        (cons 11 pp)
        '(100 . "AcDbText")
        '(73 . 2)
      ))))))
 (princ)
)
(vl-load-com)

Posted

Since DXF group 1 is string-valued, you will need to convert the numerical value returned by my LM:roundm function to a string, for example:

 

(cons 1 [color="blue"]([/color][color="blue"]itoa[/color] (lm:roundm (/ (cadr (reverse pt)) 1000.) 1)[color="blue"])[/color])

 

I have used itoa because you are rounding to the nearest integer; if this were not the case, you would need to use rtos.

Posted
Since DXF group 1 is string-valued, you will need to convert the numerical value returned by my LM:roundm function to a string, for example:

 

(cons 1 [color="blue"]([/color][color="blue"]itoa[/color] (lm:roundm (/ (cadr (reverse pt)) 1000.) 1)[color="blue"])[/color])

 

I have used itoa because you are rounding to the nearest integer; if this were not the case, you would need to use rtos.

 

Thanks Lee. My bad :oops:

Posted

Thanks Lee/ Ron, script gives no errors now but rounds up 0.5's to 1 where as i would need it to round off at multiples of 0.5 - doable?

Posted

Hi Guys,

Anychance this can coverted to feet/inches (scale 1=1inch).

 

Thanks in Advance!!

Posted

I can help get this to decimal inches! (10' 6" will display as 10.5) if you need to display as ' / " I'll apologize now!

 

 

(defun c:foo (/ lm:listclockwise-p lm:makereadable _colinear a b cw d out p pp s th)
 ;; RJP 05.03.2018
 ;; Labels exterior edges of 'stands' with edge length
 (defun _colinear (p1 p2 p3 f) (equal (+ (distance p1 p2) (distance p2 p3)) (distance p1 p3) f))
 ;; Make Readable  -  Lee Mac
 ;; Returns a given angle corrected for text readability
 (defun lm:makereadable (a)
   ((lambda (a)
      (if (and (< (* pi 0.5) a) (<= a (* pi 1.5)))
    (+ a pi)
    a
      )
    )
     (rem (+ a pi pi) (+ pi pi))
   )
 )
 ;; List Clockwise-p - Lee Mac
 ;; Returns T if the point list is clockwise oriented
 (defun lm:listclockwise-p (lst)
   (minusp (apply '+
          (mapcar (function (lambda (a b) (- (* (car b) (cadr a)) (* (car a) (cadr b)))))
              lst
              (cons (last lst) lst)
          )
       )
   )
 )
 (cond
   ((setq s (ssget '((0 . "lwpolyline") (8 . "BoothOutline"))))
    (setq th 500)[color=red];set text size here[/color]
    (foreach pl (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (setq p (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget pl))))
      (setq p
         (mapcar '(lambda (a b)
            (list (polar a (angle a b) (* 0.5 (setq d (distance a b)))) a b (angle a b) d)
              )
             p
             (append (cdr p) (list (car p)))
         )
      )
      (setq cw (lm:listclockwise-p (mapcar 'car p)))
      (setq out (cons (mapcar '(lambda    (x) (append x (list (if cw + -)))) p) out))
    )
    (foreach pt (setq out (apply 'append out))
      (and
    (null (vl-remove-if-not
        '(lambda (x)
           (or (equal (car pt) (car x) 1e-1) (_colinear (cadr x) (car pt) (caddr x) 1e-1))
         )
        (vl-remove pt out)
          )
    )
    (setq pp (polar (car pt) ((last pt) (cadddr pt) (/ pi 2.)) th))
    (entmakex
      (list
        '(0 . "TEXT")
        '(100 . "AcDbEntity")
        '(8 . "BoothOutlineLength")
        '(100 . "AcDbText")
        (cons 10 pp)
        (cons 40 th)
        '(62 . 1)
        (cons 1
          (vl-string-right-trim
            "."
            (vl-string-right-trim "0" (vl-princ-to-string (/ (cadr (reverse pt)) [color=red]12[/color].)))[color=red];unit devision here[/color]
          )
        )
        (cons 50 (lm:makereadable (cadddr pt)))
        '(72 . 1)
        (cons 11 pp)
        '(100 . "AcDbText")
        '(73 . 2)
      )
    )
      )
    )
   )
 )
 (princ)
)
(vl-load-com)

Posted

Here is your PM needs a bit to make perfect like setting some of the dim vars so round up etc. You can then control where you label the aisles.

 

; dim between two objects by crossing over the two objects
(defun c:dim-2 ( / pt1 pt2 ss obj1 obj2 obj3 pt3 pt4 oldsnap)
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(setq pt1 (getpoint "Pick inside 1st rectang"))
(setq pt2 (getpoint pt1 "2nd point inside other rectang"))
(setq ss (ssget "f" (list pt1 pt2)))
(command "line" pt1 pt2 "")
(setq obj1 (vlax-ename->vla-object (entlast )))
(setq obj2 (vlax-ename->vla-object  (ssname ss 0)))
(setq obj3 (vlax-ename->vla-object  (ssname ss 1)))
(setq pt3 (vlax-invoke obj2 'intersectWith obj1 acExtendThisEntity))
(setq pt4 (vlax-curve-getclosestpointto obj3 pt3))
(command "dimaligned" pt3 pt4 pt3 )
(vla-delete obj1)
(setvar 'osmode oldsnap)
(princ)
)

Posted

Thanks for the 'Bonus' code! works great with my dimstyle settings.

Posted

Thanks Gadget but i would like the full 10' 6" to be displayed:oops:

Posted
Thanks Gadget but i would like the full 10' 6" to be displayed:oops:

 

 

Just tried this on one of my US plans - its probably the wrong way of doing it but it works for me!:celebrate:

 

Use RJP's original code with highlighted changes

 

 

 



(defun c:foo (/ lm:listclockwise-p lm:makereadable _colinear a b cw d out p pp s th)

 ;; RJP 05.03.2018
 ;; Labels exterior edges of 'stands' with edge length
 (defun _colinear (p1 p2 p3 f) (equal (+ (distance p1 p2) (distance p2 p3)) (distance p1 p3) f))

 ;; Make Readable  -  Lee Mac
 ;; Returns a given angle corrected for text readability
 (defun lm:makereadable (a)
   ((lambda (a)
      (if (and (< (* pi 0.5) a) (<= a (* pi 1.5)))
    (+ a pi) a ))(rem (+ a pi pi) (+ pi pi))))
        (defun c:foo (/ lm:makereadable _colinear a b d out p pp s th)
         ;; RJP 05.03.2018
         ;; Labels exterior edges of 'stands' with edge length
         (defun _colinear (p1 p2 p3 f) (equal (+ (distance p1 p2) (distance p2 p3)) (distance p1 p3) f))
         ;; Make Readable  -  Lee Mac
         ;; Returns a given angle corrected for text readability
         (defun lm:makereadable (a)
           ((lambda (a)
              (if (and (< (* pi 0.5) a) (<= a (* pi 1.5)))
            (+ a pi)
            a
              )
            )
             (rem (+ a pi pi) (+ pi pi))
           )
         )
         (cond
           ((setq s (ssget '((0 . "lwpolyline") (8 . "BoothOutline"))))
            (setq th [color=red]20[/color]) [color=red];Text size[/color]
            (foreach pl (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
              (setq p (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget pl))))
              (setq p
                 (mapcar '(lambda (a b)
                    (list (polar a (angle a b) (* 0.5 (setq d (distance a b)))) a b (angle a b) d)
                      )
                     p
                     (append (cdr p) (list (car p)))
                 )
              )
              (setq out (cons p out))
            )
            (foreach pt (setq out (apply 'append out))
              (and
            (null (vl-remove-if-not
                '(lambda (x)
                   (or (equal (car pt) (car x) 1e-1) (_colinear (cadr x) (car pt) (caddr x) 1e-1))
                 )
                (vl-remove pt out)
                  )
            )
            (setq pp (polar (car pt) (- (cadddr pt) (/ pi 2.)) th))
            (entmakex (list '(0 . "TEXT")
                    '(100 . "AcDbEntity")
                    '(8 . "BoothOutlineLength")
                    '(100 . "AcDbText")
                    (cons 10 pp)
                    (cons 40 th)
                    '(62 . 1)
                    (cons 1 (rtos (/ (last pt) 1.) [color=red]4 [/color]1));[color=red] 4 = Feet fraction inches[/color]                     (cons 50 (lm:makereadable (cadddr pt)))
                    '(72 . 1)
                    (cons 11 pp)
                    '(100 . "AcDbText")
                    '(73 . 2)
                  )
            )
              )
            )
           )
         )
         (princ)
       )
       (vl-load-com)
)

Posted
Thanks Lee/ Ron, script gives no errors now but rounds up 0.5's to 1 where as i would need it to round off at multiples of 0.5 - doable?

 

Change the 'multiple' from 1 to 0.5 and use rtos in place of itoa -

 

(cons 1 [color=blue](rtos [/color](lm:roundm (/ (cadr (reverse pt)) 1000.) [color=red]0.5[/color])[color=blue])[/color])

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