Plaster&Insulation lisp

Plaster&Insulation lisp

bilgimimaridosya
Observer Observer
203 Views
1 Reply
Message 1 of 2

Plaster&Insulation lisp

bilgimimaridosya
Observer
Observer

HELLO,

I am trying to solve my own problem by editing the lisps I found on the internet. My goal is to add plaster + insulation + plaster to the outside of the wall. I need 3 layers here.

 

1- Plaster-A
2- Insulation
3- Plaster-B

 

I want the plasters to have hatch hatch.
I want the plaster to have a batting line type in the middle.
Plaster-A, Plaster-B and Insulation widths should be different.

 

I added a visual of the final output I want.

 

bilgimimarid_0-1739095779820.png

 

 

I am using a code that can help me, but I cannot choose the plaster thicknesses independently. Also, the insulation hatch is visible, I want it to be in the form of batting line.

 

(vl-load-com) ; load activex support

(defun c:yt-kda (/ initial askhizalama askReal askInt 					; local functions
		  askPoint sharp_angle is_overlap is_inters duplicate_offset draw_bar  	; local functions
	          F-RATIO LAYERS hizalama Sıva Yalıtım Tarama ss0 p0 p1 points^ AcDbPLine) ; local variables

 ; initial setup
 (defun initial ()
  (if (or
	(eq (getvar "users1") "")
	(not (member (getvar "users1") '("Soldan-Sağa" "Ortadan" "Sağdan-Sola")))
      )
   (setq hizalama (setvar "users1" "Soldan-Sağa"))
   (setq hizalama (getvar "users1"))
  ); if

  ; for Sıva width
  (if (eq (getvar "userr1") 0.0)
   (setq Sıva (setvar "userr1" 11.0))
   (setq Sıva (abs (getvar "userr1")))
  ); if

  ; for Yalıtım width
  (if (eq (getvar "userr2") 0.0)
   (setq Yalıtım (setvar "userr2" 6.0))
   (setq Yalıtım (abs (getvar "userr2")))
  ); if

 (setq F-RATIO 1.0) ; const
(if (> (/ (getvar "userr2") (getvar "userr1")) F-RATIO)
 (setq Yalıtım (fix (* F-RATIO pluster)))
)

  ; for Tarama scale
  (if (eq (getvar "userr3") 0.0)
   (setq Tarama (setvar "userr3" 1.0))
   (setq Tarama (abs (getvar "userr3")))
  ); if


  (setq LAYERS '(("Dış-sıva-kda" . 50) ("Dış-yalıtım-kda" . 40) ("Dış-sıva-tarama-kda" . 40))) ; const
   
  ; create layers & colors
  (foreach lay LAYERS
   (if (null (tblsearch "layer" (car lay)))
    (command "._layer" "_new" (car lay) "_color" (cdr lay) (car lay) "")
   ); if
  ); foreach
 ); initial


  ; pause for user input - Hizalama
 (defun askhizalama (def / ask)
  (initget "Soldan-Sağa Ortadan Sağdan-Sola")
  (if (not (setq ask (getkword (strcat "\nBir Hizalama Seçin [Soldan-Sağa/Ortadan/Sağdan-Sola] <" def ">: "))))
   (setq ask def)
   (setq def ask)
  ); if
 ); askhizalama


 ; pause for user input - Yalıtım scale
 (defun askReal (msg def / ask)
  (initget (+ 2 4))
  (if (not (setq ask (getreal (strcat "\n" msg " <" (rtos def 2) ">: "))))
   (setq ask def)
   (setq def ask)
  ); if
 ); askReal


 ; pause for user input - Tarama ratio
 (defun askInt (msg def / ask)
  (initget (+ 2 4))
  (if (not (setq ask (getint (strcat "\n" msg " <" (itoa def) ">: "))))
   (setq ask def)
   (setq def ask)
  ); if
 ); askInt

  
 ; pause for user input - points
 (defun askPoint (msg / pt ask Result)
  (cond
   ((not points^)
    (setq pt t)
    (while (and
	     pt
	     (not (prompt (strcat "\nMevcut Ayarlar: Hizalama = " hizalama ", Sıva = " (rtos Sıva 2) ", Yalıtım = " (rtos Yalıtım 2) ", Tarama = " (rtos Tarama 2))))
	     (not (initget "Hizalama Sıva Yalıtım Tarama"))
             (setq pt (getpoint (strcat "\n" msg " or [Hizalama/Sıva Kalınlığı/Yalıtım Kalınlığı/Tarama Ölçeği]: ")))
	   )
     (cond
      ((eq pt "Hizalama")
       (setvar "users1" (setq hizalama (askhizalama hizalama)))
      ); case
      ((eq pt "Sıva")
       (setvar "userr1" (setq Sıva (askReal "Sıva Soldan-Sağa dışa kaç cm olsun?" Sıva)))       
      ); case
      ((eq pt "Yalıtım")
       (if (> (/ (setvar "userr2" (setq Yalıtım (askReal "Yalıtım kaç cm olsun?" Yalıtım))) Sıva) F-RATIO)
        (progn
	 (vlr-beep-reaction)
	 (prompt "\n* Yalıtım değeri sıvadan daha küçük olmak zorunda, tersi mümkün müdür? *")
         (setvar "userr2" (setq Yalıtım (* F-RATIO Sıva)))
	); progn
       ); if
      ); case
      ((eq pt "Tarama")
       (setvar "userr3" (setq Tarama (askReal "Tarama ölçeği" Tarama)))       
      ); case
      ( t
       (setq Result pt pt nil)
      ); case
     ); cond
    ); while
    
    Result ; return
   ); case
   ((= (vl-list-length points^) 1)
    (setq pt (getpoint (last points^) (strcat "\n" msg ": ")))
   ); case
   ( t
    (initget "Undo")
    (setq pt (getpoint (last (reverse points^)) (strcat "\n" msg " or [Undo]: ")))
   ); case
  ); cond
 ); askPoint


 ; return right angle in triangle
 (defun sharp_angle (t1 t2 t3 / a0 a1 a2)
  (setq a0 (angle t2 t1))
  (setq a1 (angle t2 t3))

  (if (> a0 a1)
   (setq a2 (- a0 a1))
   (setq a2 (- a1 a0))
  )

  (if (> a2 (* pi 1.5))
   (- (* pi 2) a2)
   a2
  ); if
 ); sharp_angle


 ; return T if segments is overlapping
 (defun is_overlap (t1 / t2 t3)
  (setq t2 (cadr points^))
  (setq t3 (car points^))
  (equal (* (sin (sharp_angle t1 t2 t3)) (distance t2 t1)) 0.0 1e-3)
 ); is_overlap
  

  ; return t if segments are intersect
 (defun is_inters (t0 t1 / lst)
  (setq lst (reverse (cdr points^))) ; chop last point
   
  (vl-some
   (function
    (lambda (t2 t3)
     (inters t0 t1 t2 t3)
    ); lambda 
   ); function
   (reverse (cdr (reverse lst))) (cdr lst)
  ); vl-some
 ); is_inters


 ; offset/copy pline 
 (defun duplicate_offset (scl / AcDbObj coords pt)
  (if (= scl 0.0)
   (setq AcDbObj (vla-copy AcDbPLine))
   (setq AcDbObj (car (vlax-safearray->list (vlax-variant-value (vla-offset AcDbPLine scl)))))
  )
    
  (setq coords (reverse (vlax-safearray->list (vlax-variant-value (vla-get-coordinates AcDbObj)))))
  (setq pt (list (cadr coords) (car coords))) ; get last point

  (vlax-release-object AcDbObj)
     
  pt
 ); duplicate_offset

  
 ;  draw frame
 (defun draw_bar (scl^ / ss1 t0 t1)
  (setq ss1 (ssadd))
  (cond
   ((eq hizalama "Ortadan")
    (setq t0 (duplicate_offset (nth 0 scl^)))
    (ssadd (entlast) ss1)
    (setq t1 (duplicate_offset (nth 1 scl^)))
    (ssadd (entlast) ss1)
   ); case
   ((eq hizalama "Soldan-Sağa")
    (setq t0 (duplicate_offset (nth 2 scl^)))
    (ssadd (entlast) ss1)
    (setq t1 (duplicate_offset (nth 3 scl^)))
    (ssadd (entlast) ss1)
   ); case
   ((eq hizalama "Sağdan-Sola")
    (setq t0 (duplicate_offset (nth 4 scl^)))
    (ssadd (entlast) ss1)
    (setq t1 (duplicate_offset (nth 5 scl^)))
    (ssadd (entlast) ss1)
   ); case
  ); cond

  (command "._pline" "_None" t0 "_None" t1 "")
  (ssadd (entlast) ss1)
  (command "._pedit" "_multiple" "_si" ss1 "_join" "" "_close" "")
 ); draw_bar
 
  
 ; here start c:cYalıtım
 (setvar "cmdecho" 0)
 (command "._undo" "_begin")
 
 (initial) ; set some defaults + create layers
   
 (setq ss0 (ssadd))
  
 (if (setq p0 (askPoint "Yeni nokta seçin"))
  (progn
   (setq points^ (cons p0 points^))
   (while (setq p1 (askPoint "Yeni nokta seçin"))
    (cond
     ((= p1 "Undo")
      (command "._erase" "_si" "_last")
      (if (> (sslength ss0) 0)
       (ssdel (ssname ss0 (1- (sslength ss0))) ss0) ; remove last added
      )
      (setq points^ (cdr points^) p0 (car points^)) ; remove last point
     ); case
     ((and
	(> (vl-list-length points^) 1)
	(is_overlap p1)
      )
      (vlr-beep-reaction)
      (prompt "\nerror: HÖÖÖYT- Ne çizdiğine bakmalısın, Üst üste binmek yasaktır.")
     ); case
     ((and
	(> (vl-list-length points^) 2)
	(is_inters p0 p1)
      )
      (vlr-beep-reaction)
      (prompt "\nerror: HÖÖÖYT- Ne çizdiğine bakmalısın, Kesişmek yasaktır.")
     ); case
     ( t	
      (command "._line" "_None" p0 "_None" p1 "")
      (ssadd (entlast) ss0)
      (setq points^ (cons p1 points^) p0 p1)
     ); case
    ); cond
   ); while

   (command "._erase" "_si" ss0) ; delete origin geometric

   (if (> (vl-list-length points^) 1)
    (progn
     (setq points^ (reverse points^))

     (command "._pline" "_None" (car points^) "_width" 0 0)
     (foreach p0 (cdr points^)
      (command "_None" p0)
     ); foreach
     (command "")
     (setq AcDbPLine (vlax-ename->vla-object (entlast)))

     (draw_bar (list (* Sıva 0.5) (* Sıva -0.5)
		      0.0             Sıva
		      0.0             (* -1 Sıva)
	       )
     )
     (command "._chprop" "_si" "_Last" "_Layer" (caar LAYERS) "")

     (draw_bar (list (* Yalıtım  0.5)                 (* Yalıtım -0.5)
		     (/ (- Sıva Yalıtım) 2)        (- Sıva (/ (- Sıva Yalıtım) 2))
	             (* -1 (/ (- Sıva Yalıtım) 2)) (* -1 (- Sıva (/ (- Sıva Yalıtım) 2)))
	       )
     )
     
     (command "._chprop" "_si" "_Last" "_Layer" (caadr LAYERS) "")
     (command "._-bhatch" "_Select" "_Last" "" "_Properties" "zigzag" Tarama 0 "_Layer" (caaddr LAYERS) "")




     (vla-delete AcDbPLine)
     (vlax-release-object AcDbPLine)
    ); progn
   ); if
  ); progn
 ); if
  
 (command "._undo" "_end")
 (setvar "cmdecho" 1)

 (princ)
);
0 Likes
204 Views
1 Reply
Reply (1)
Message 2 of 2

Sea-Haven
Mentor
Mentor

Two suggestions, use mline for drawing the wall lines, you can have the linework on different layers. The other is rather than use the USERS1 variable as this can be changed by other lisp programs, you can use LDATA. Where you can have custom names for your database and variable names.

 

(setq ahsc (vlax-ldata-put "AlanH" "Ahscale" 100)) ;save value

(setq ahsc (vlax-ldata-get "AlanH" "Ahscale")) ; get value

 

0 Likes