Author Topic: Help with DoubleOffset lisp - LeeMac Code  (Read 3473 times)

0 Members and 1 Guest are viewing this topic.

PM

  • Guest
Help with DoubleOffset lisp - LeeMac Code
« on: April 10, 2021, 10:42:26 AM »
Hi. I am using LeeMac code for Double offset . I want an update to this code.
I need to select all lines in layer "ROOF-AXIS" and double offset them (0.08m of each side) and the put the offset lines in layer "ROOF"


Code - Auto/Visual Lisp: [Select]
  1.   (command "_layer" "_m" "ROOF" "_c" "90" "" "")
  2.  

Code - Auto/Visual Lisp: [Select]
  1. (defun c:DOff2 nil (c:DoubleOffset))
  2.  
  3. (defun c:DoubleOffset ( / *error* _StartUndo _EndUndo DoubleOffset doc exitflag layer mpoint obj object of point sel symbol value )
  4.  
  5.   (defun *error* ( msg )    
  6.     (and doc (_EndUndo doc))
  7.     (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
  8.         (princ (strcat "\n** Error: " msg " **")))
  9.     (princ)
  10.   )
  11.  
  12.   (defun _StartUndo ( doc ) (vla-StartUndoMark doc))
  13.  
  14.   (defun _EndUndo   ( doc ) (if (= 8 (logand 8 (getvar 'UNDOCTL))) (vla-EndUndomark doc)))
  15.  
  16.   (defun DoubleOffset ( object offset layer )
  17.     (mapcar
  18.       (function
  19.         (lambda ( o )
  20.           (if
  21.             (and
  22.               (not
  23.                 (vl-catch-all-error-p
  24.                   (setq o
  25.                     (vl-catch-all-apply
  26.                       (function vlax-invoke) (list object 'Offset o)
  27.                     )
  28.                   )
  29.                 )
  30.               )
  31.               layer
  32.             )
  33.             (mapcar
  34.               (function
  35.                 (lambda ( o )
  36.                   (vla-put-layer o (getvar 'CLAYER))
  37.                 )
  38.               )
  39.               o
  40.             )
  41.           )
  42.         )
  43.       )
  44.       (list offset (- offset))
  45.     )
  46.   )
  47.  
  48.  
  49.   (mapcar
  50.     '(lambda ( symbol value ) (or (boundp symbol) (set symbol value)))
  51.     '(*dOff:Erase *dOff:Layer) '("No" "Source")
  52.   )
  53.  
  54.   (if
  55.     (progn
  56.       (while
  57.         (progn
  58.           (princ
  59.             (strcat
  60.               "\nCurrent Settings: Erase source="
  61.               *dOff:Erase
  62.               "  Layer="
  63.               *dOff:Layer
  64.               "  OFFSETGAPTYPE="
  65.               (itoa (getvar 'OFFSETGAPTYPE))
  66.             )
  67.           )
  68.           (initget 6 "Through Erase Layer")
  69.           (setq of
  70.             (getdist
  71.               (strcat "\nSpecify Offset Distance [Through/Erase/Layer] <"
  72.                 (if (minusp (getvar 'OFFSETDIST)) "Through"  (rtos (getvar 'OFFSETDIST))) "> : "
  73.               )
  74.             )
  75.           )
  76.           (cond
  77.             (
  78.               (null of) (not (setq of (getvar 'OFFSETDIST)))
  79.             )
  80.             (
  81.               (eq "Through" of) (setq of (setvar 'OFFSETDIST -1)) nil
  82.             )
  83.             (
  84.               (eq "Erase" of) (initget "Yes No")
  85.  
  86.               (setq *dOff:Erase
  87.                 (cond
  88.                   (
  89.                     (getkword
  90.                       (strcat "\nErase source object after offsetting? [Yes/No] <" *doff:Erase "> : ")
  91.                     )
  92.                   )
  93.                   ( *dOff:Erase )
  94.                 )
  95.               )
  96.             )
  97.             (
  98.               (eq "Layer" of) (initget "Current Source")
  99.  
  100.               (setq *dOff:Layer
  101.                 (cond
  102.                   (
  103.                     (getkword
  104.                       (strcat "\nEnter layer option for offset objects [Current/Source] <" *dOff:Layer "> : ")
  105.                     )
  106.                   )
  107.                   ( *dOff:Layer )
  108.                 )
  109.               )
  110.             )
  111.             ( of (setvar 'OFFSETDIST of) nil )
  112.           )
  113.         )
  114.       )
  115.       of
  116.     )
  117.     (while
  118.       (progn
  119.         (or ExitFlag
  120.           (progn (initget "Exit")
  121.             (setq sel (entsel "\nSelect object to offset or [Exit] <Exit> : "))
  122.           )
  123.         )
  124.        
  125.         (cond
  126.           (
  127.             (or ExitFlag (null sel) (eq sel "Exit")) nil
  128.           )
  129.           ( (vl-consp sel)
  130.  
  131.             (_EndUndo doc) (_StartUndo doc)
  132.  
  133.             (if (and (wcmatch (cdr (assoc 0 (entget (car sel)))) "ARC,CIRCLE,ELLIPSE,SPLINE,LWPOLYLINE,XLINE,LINE")
  134.                      (setq obj (vlax-ename->vla-object (car sel))))
  135.  
  136.               (if (minusp of)
  137.                 (if
  138.                   (progn (initget "Exit Multiple")
  139.                     (and
  140.                       (setq point (getpoint "\nSpecify through point or [Exit/Multiple] <Exit> : "))
  141.                       (not (eq "Exit" point))
  142.                     )
  143.                   )
  144.                   (if (eq "Multiple" point)
  145.                     (while
  146.                       (progn (initget "Exit")
  147.                         (setq mpoint (getpoint "\nSpecify through point or [Exit] <next object> : "))
  148.  
  149.                         (cond
  150.                           (
  151.                             (eq "Exit" mpoint)
  152.  
  153.                             (if (eq "Yes" *dOff:Erase) (vla-delete obj))
  154.  
  155.                             (not (setq ExitFlag t))
  156.                           )
  157.                           (
  158.                             (null mpoint)
  159.  
  160.                             (if (eq "Yes" *dOff:Erase) (vla-delete obj))
  161.  
  162.                             nil
  163.                           )
  164.                           (
  165.                             (listp mpoint)
  166.                            
  167.                             (DoubleOffset obj
  168.                               (distance (trans mpoint 1 0)
  169.                                 (vlax-curve-getClosestPointto (car sel) (trans mpoint 1 0) t)
  170.                               )
  171.                               (eq "Current" *dOff:Layer)
  172.                             )
  173.                            t
  174.                           )
  175.                         )
  176.                       )
  177.                     )
  178.                     (progn
  179.                       (DoubleOffset obj
  180.                         (distance (trans point 1 0)
  181.                           (vlax-curve-getClosestPointto (car sel) (trans point 1 0) t)
  182.                         )
  183.                         (eq "Current" *dOff:Layer)
  184.                       )
  185.                       (if (eq "Yes" *dOff:Erase) (vla-delete obj))
  186.                      t
  187.                     )
  188.                   )
  189.                   (setq ExitFlag t)
  190.                 )
  191.                 (progn
  192.                   (DoubleOffset obj of (eq "Current" *dOff:Layer))
  193.  
  194.                   (if (eq "Yes" *dOff:Erase) (vla-delete obj))
  195.                 )
  196.               )
  197.               (princ "\n** Cannot Offset that Object **")
  198.             )
  199.            t
  200.           )
  201.         )
  202.       )
  203.     )
  204.   )  
  205.   (_EndUndo doc) (princ)
  206. )  
  207.  
  208.  (princ)
  209.  
  210.  

Thanks

Tharwat

  • Swamp Rat
  • Posts: 707
  • Hypersensitive
Re: Help with DoubleOffset lisp - LeeMac Code
« Reply #1 on: April 10, 2021, 12:09:20 PM »
Here you go.
Code - Auto/Visual Lisp: [Select]
  1. (defun c:Test ( / sel int ent )
  2.   ;; Tharwat - Date : 10.Apr.2021       ;;
  3.   (and (or (tblsearch "LAYER" "ROOF")
  4.          (alert "Layer name < ROOF >  was not found in this drawing to continue!")
  5.          )
  6.      (princ "\nSelect lines on layer < ROOF-AXIS > to offset on two sides 0.08 m : ")
  7.      (setq int -1 sel (ssget "_:L" '((0 . "LINE")(8 . "ROOF-AXIS"))))
  8.      (while (setq int (1+ int) ent (ssname sel int))
  9.        (foreach off '(0.08 -0.08)
  10.          (vla-put-layer (car (vlax-invoke (vlax-ename->vla-object ent) 'offset off)) "ROOF")
  11.          )
  12.        )
  13.      )
  14.  

PM

  • Guest
Re: Help with DoubleOffset lisp - LeeMac Code
« Reply #2 on: April 10, 2021, 12:28:56 PM »
HI Tharwat

I try to change your code to automatic select this lines by is not work !!!



Code - Auto/Visual Lisp: [Select]
  1.     (defun c:Test ( / sel int ent )
  2.       ;; Tharwat - Date : 10.Apr.2021       ;;
  3.       (and (or (tblsearch "LAYER" "ROOF")
  4.              (alert "Layer name < ROOF >  was not found in this drawing to continue!")
  5.              )
  6.          ;(princ "\nSelect lines on layer < ROOF-AXIS > to offset on two sides 0.08 m : ")
  7.          (ssget "_x" '((0 . "*LINE") (8 . "ROOF-AXIS")))  ; < ----- add this line
  8.          (setq int -1 sel (ssget "_:L" '((0 . "LINE")(8 . "ROOF-AXIS"))))
  9.          (while (setq int (1+ int) ent (ssname sel int))
  10.            (foreach off '(0.08 -0.08)
  11.              (vla-put-layer (car (vlax-invoke (vlax-ename->vla-object ent) 'offset off)) "ROOF")
  12.              )
  13.            )
  14.          )
  15.     (princ)
  16.     ) (vl-load-com)
  17.      
  18.  
  19.  

Tharwat

  • Swamp Rat
  • Posts: 707
  • Hypersensitive
Re: Help with DoubleOffset lisp - LeeMac Code
« Reply #3 on: April 10, 2021, 12:32:57 PM »
Replace this part from my original posted codes and please modify your post and remove your posted codes.
Code - Auto/Visual Lisp: [Select]
  1.  (setq int -1 sel (ssget "_X" '((0 . "LINE")(8 . "ROOF-AXIS"))))

Be sure to have the layer ROOF-AXIS unlocked.


PM

  • Guest
Re: Help with DoubleOffset lisp - LeeMac Code
« Reply #4 on: April 10, 2021, 12:34:51 PM »
Thanks

PM

  • Guest
Re: Help with DoubleOffset lisp - LeeMac Code
« Reply #5 on: April 10, 2021, 12:42:25 PM »
I want ro ask you some thing else . Is it possible after the offset to fillet 0 all this lines in ROOF layer?

BIGAL

  • Swamp Rat
  • Posts: 1396
  • 40 + years of using Autocad
Re: Help with DoubleOffset lisp - LeeMac Code
« Reply #6 on: April 10, 2021, 09:13:33 PM »
It would be better to make all the joining lines to plines use pedit Join, then run the offset lisp it will auto fillet then.
A man who never made a mistake never made anything

PM

  • Guest
Re: Help with DoubleOffset lisp - LeeMac Code
« Reply #7 on: April 11, 2021, 02:26:45 AM »
Hi Bigal. I use this code to make roof. I did a combination with Tharwat code. My results is in the attach file. I want to trim -extend the offset lines to perimetric roof polylime  and fill with ANSI31 hatch like the attach file.
« Last Edit: April 11, 2021, 02:32:47 AM by PM »

PM

  • Guest
Re: Help with DoubleOffset lisp - LeeMac Code
« Reply #8 on: April 11, 2021, 02:34:02 AM »
The ROOF dwg  updated in the previous post

BIGAL

  • Swamp Rat
  • Posts: 1396
  • 40 + years of using Autocad
Re: Help with DoubleOffset lisp - LeeMac Code
« Reply #9 on: April 11, 2021, 08:43:22 PM »
I think the ridge tops can be filleted by using a circle approach, and checking for a intersectwith, not sure can be automated, may look at making a circle on each end of red lines. The same with eave end it will be a trim or extend. Will have a think about it.

polygon
get co-ord
(setq ss (ssget "F" co-ord '((8 . "ROOF")(0 . "LINE"))))
need to do a distanceatpoint along the polygon via  intersectwith so can sort the line order into pairs then can fillet
« Last Edit: April 11, 2021, 09:01:14 PM by BIGAL »
A man who never made a mistake never made anything

PM

  • Guest
Re: Help with DoubleOffset lisp - LeeMac Code
« Reply #10 on: April 12, 2021, 11:12:19 AM »
can any one fix it?

BIGAL

  • Swamp Rat
  • Posts: 1396
  • 40 + years of using Autocad
Re: Help with DoubleOffset lisp - LeeMac Code
« Reply #11 on: April 12, 2021, 11:22:04 PM »
Need some time made a start on it be patient.
A man who never made a mistake never made anything

PM

  • Guest
Re: Help with DoubleOffset lisp - LeeMac Code
« Reply #12 on: April 13, 2021, 01:37:20 AM »
Thanks BIGAL

BIGAL

  • Swamp Rat
  • Posts: 1396
  • 40 + years of using Autocad
Re: Help with DoubleOffset lisp - LeeMac Code
« Reply #13 on: April 15, 2021, 12:30:16 AM »
Sorry took so long had a few other tasks, it only does ridge caps at moment, there is one spot where in you sample it will not work as you have 2 ridges to close so the search polygon gets confused. So just pick the top of the red line. The same method should be able to be used on the eaves.

Code: [Select]
; fillet offset roof ridges for offset lines equal ridge capping.
; by AlanH April 2021 info@alanh.com.au

(defun AHpllst ( lstpl / x)
(command "_pline")
(while (= (getvar "cmdactive") 1 )
(repeat (setq x (length lstpl))
(command (nth (setq x (- x 1)) lstpl))
)
(command "")
)
)


(defun c:test  ( / oldsnap)
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 1)
(while (setq pt (getpoint "\nPick ridge point "))
(setvar 'osmode 0)
;(setq pt2 (getpoint pt "\nPick gap in ridge lines "))
; (setq ang  (angle pt pt2))
(setq ang 0.0)
(setq pi20 (/ (* 2.0 pi) 20.0))
(setq co-ord '())
(repeat 20
(setq pt2 (polar pt (setq ang (+ pi20 ang)) 0.3))
(setq co-ord (cons pt2 co-ord))
)
(setq co-ord (cons (last  co-ord) co-ord))
(AHpllst co-ord)

(setq obj1 (vlax-ename->vla-object (entlast)))

(setq ss (ssget "F" co-ord '((0 . "LINE")(8 . "ROOF"))))

(setq lst '())
(repeat (setq x (sslength ss))
(setq ent (ssname ss (setq x (- x 1))))
(setq obj2 (vlax-ename->vla-object ent))
(setq pt (vlax-invoke obj2 'intersectWith obj1 acExtendnone))
(setq dist (vlax-curve-getdistatpoint obj1 pt))
(setq lst (cons (list dist pt (cdr (assoc -1 (entget ent)))) lst))
)
(setq lst (vl-sort lst '(lambda (x y) (< (car x)(car y)))))

(vla-delete obj1)
(setvar 'filletrad 0.0)

(setq x 1)
(setvar 'osmode 512)
(setq x 1)
(repeat (- (/ (length lst) 2) 1)
(setq l1 (entget (nth 2 (nth x lst))))
( setq pt1 (mapcar '* (mapcar '+ (cdr (assoc 10 l1)) (cdr (assoc 11 l1))) '(0.5 0.5)))
(setq l2 (entget (nth 2 (nth (+ x 1) lst))))
( setq pt2 (mapcar '* (mapcar '+ (cdr (assoc 10 l2)) (cdr (assoc 11 l2))) '(0.5 0.5)))

(command "fillet" pt1 pt2  )
(setq x (+ x 2))
)
(setq l1 (entget (nth 2 (nth 0 lst))))
( setq pt1 (mapcar '* (mapcar '+ (cdr (assoc 10 l1)) (cdr (assoc 11 l1))) '(0.5 0.5)))
(setq l2 (entget (nth 2 (last lst))))
( setq pt2 (mapcar '* (mapcar '+ (cdr (assoc 10 l2)) (cdr (assoc 11 l2))) '(0.5 0.5)))
(command "fillet" pt1 pt2  )

(setvar 'osmode 1)

)
(setvar 'osmode oldsnap)
(princ)

)
(c:test)


A man who never made a mistake never made anything

PM

  • Guest
Re: Help with DoubleOffset lisp - LeeMac Code
« Reply #14 on: April 15, 2021, 01:49:40 AM »
Hi BIGAL . Thanks for your time. I try your code but is not working as i expect. Is faster to do filet 0 . Your code create arcs in the roof and became a mess.

Thanks again