Topic: Shadow Line

[GDF]

I am looking for a better way to create a shadow line, than the poor attempt in coding that I have below. See image of what I am after.
I use this for creating a shadow line in an exterior elevation arch opening.

The code below will work for only one object at a time <arc or line>...I would like it to work for both within one pass.

Code: [Select]

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;; Shadow Line Polyline Function ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:PP ()
  (PP-IT)
  ;;(while (= ARCH#LOOP "On")(PP-IT))
  (princ)
)
(defun PP-IT (/ PL SSET SS ENTS STPT CNT NCNT PNT)
  (prompt
    "\n* Select Existing Arc to Offset..to become new \"Pline Shadow\" *"
  )
  ;;(ARCH:F_S-VAR)
  (setvar "cmdecho" 0)
  ;;(ARCH:CUSTOM_LAYERS-PATT)
  (setq PL (getvar "plinetype"))
  (setvar "plinetype" 2)
  (setq SS (ssadd))
  (setq SSET (ssget '((0 . "ARC,*LINE")))) 
  (setq PNT (getpoint "\n* Pick side to offset on *"))
  (setvar "osmode" 0)
  (command ".offset" "4.5" SSET (princ PNT) "")
  (setq SSET (ssadd (entlast) SS))
  (command "change" SSET "" "P" "LA" (getvar "clayer") "c" "8" "")
  (setq SSET (ssadd (entlast) SS))
  (progn
    (if (= (cdr (assoc 0 (entget (ssname SSET 0)))) "LINE")     
      (cond
        ((< (distof (substr (getvar "acadver") 1 4)) 16.1)(command "pedit" SSET "y" "w" "8" ""))
        ((>= (distof (substr (getvar "acadver") 1 4)) 16.1)(command "pedit" SSET "w" "8" ""))
      )
    )
    (if (or (= (cdr (assoc 0 (entget (ssname SSET 0)))) "POLYLINE")
            (= (cdr (assoc 0 (entget (ssname SSET 0)))) "LWPOLYLINE")
        )
      (command "pedit" SSET "w" "8" "")
    )
  ) 
  (setq SS (ssadd))
  (cond
    ((= (cdr (assoc 0 (entget (ssname SSET 0)))) "ARC")       
     (cond
       ((< (distof (substr (getvar "acadver") 1 4)) 16.1)(command "pedit" SSET "y" ""))
       ((>= (distof (substr (getvar "acadver") 1 4)) 16.1)(command "pedit" SSET ""))
     )
     (setq CNT 0
           NCNT 0
     )
     (setq SSET (ssadd (entlast) SS))
     (if SSET
       (progn
         (repeat (sslength SSET)
           (setq ENTS (entget (ssname SSET CNT))
                 STPT (cdr (assoc 40 ENTS))
           )
           (setq ENTS (vl-remove (assoc 43 ENTS) ENTS))
           (entmod ENTS)
           (if (= STPT 0)
             (progn
               (setq STPT 8)
               (setq ENTS
                      (subst (cons 40 STPT)
                             (assoc 40 ENTS)
                             ENTS
                      )
               )
               (entmod ENTS)
               (setq CNT (1+ CNT))
             )
             (progn
               (setq NCNT (1+ NCNT))
               (prompt
                 (strcat "\n" (itoa NCNT) " Polyline<s> already Zero.")
               )
             )
           )
         )
         (prompt (strcat "\n* " (itoa CNT) " Polyline<s> Changed *"))
       )
       (prompt "\n* No Polylines Found *")
     )
    )
  )
  (setvar "plinetype" PL)
  (princ "\n* \"Pline Shadow\" completed *")
  ;;(ARCH:F_R-VAR)
  (princ)
)

Gary

[whdjr]

You could make a closed polyline witha gradient fill.

[CAB]

Gary,
You might try this.

ssget the arc & line together
test for arc & line or pline
make a pline from information from the two and include the width you need
offset the new pline to side selected
delete the first new entity
edit the new pline end point of the bulge back to the original arc end or start point

[whdjr]

Sorry for my earlier outburst... ...alas I failed to fully read the directions.  (Typical Male behavior)

[GDF]

Gary,
You might try this.

ssget the arc & line together
test for arc & line or pline
make a pline from information from the two and include the width you need
offset the new pline to side selected
delete the first new entity
edit the new pline end point of the bulge back to the original arc end or start point

Allen

Thanks, I will give it a try. I just don't want to end up with any one of these below: ee image>.

Gary

[CAB]

Gary,
I took a stab at it but have run out of time today.
It is still a rough test routine but you may want to take it to the next level.
You select the line and arc together & the pline is created. No need to pick the side.
I used the offset command but that can be changed to vla method later.

[GDF]

Gary,
I took a stab at it but have run out of time today.
It is still a rough test routine but you may want to take it to the next level.
You select the line and arc together & the pline is created. No need to pick the side.
I used the offset command but that can be changed to vla method later.

Allen, you have done it again....THANKS.

Gary

[Fatty]

Hi Gary
Try it (very rough as always)

Code: [Select]

;;by Juergen Menzi
(defun MeCalcBulge (Rad Dst Dir / HlfCho TmpBlg)
 (setq HlfCho (/ Dst 2.0)
       TmpBlg (if (/= Rad 0)
               (/ (- Rad (Sqrt (abs (- (expt Rad 2) (expt HlfCho 2))))) HlfCho)
               0.0
              )
 )
 (if Dir (- TmpBlg) TmpBlg)
)

(defun c:pp ()
(vl-load-com)
(or adoc
      (setq adoc
     (vla-get-activedocument
       (vlax-get-acad-object)
     )
      )
  )
(if (and
(= (getvar "tilemode") 0)
(= (getvar "cvport") 1)
      )
    (setq acsp (vla-get-paperspace adoc))
    (setq acsp (vla-get-modelspace adoc))
  )
(setq ss (ssget (list (cons 0 "ARC,LINE"))))
(if (= (sslength ss) 2)
(progn
(repeat 2
  (setq en1 (ssname ss 0)
en2 (ssname ss 1)))
  (if (eq (cdr (assoc 0 (entget en1))) "LINE")
    (progn
      (setq line en1
    arc en2))
    (progn
      (setq line en2
    arc en1)))
  (setq arc (vlax-ename->vla-object arc)
cpt (vlax-get arc 'Center)
rad (vlax-get arc 'Radius)
inca (- (vlax-get arc 'EndAngle)(vlax-get arc 'StartAngle))
spa (vlax-get arc 'StartPoint)
epa (vlax-get arc 'EndPoint)
bul1 (MeCalcBulge Rad
      (distance (vlax-get arc 'StartPoint)(vlax-get arc 'EndPoint)) T)
)
  (setq p1 (vlax-curve-getstartpoint line)
p2 (vlax-curve-getendpoint line))
  (if (> (cadr p2)(cadr p1))
    (progn
      (setq spt p1
    ept p2))
    (progn
      (setq spt p2
    ept p1)))
  (if (> (angle spt cpt) (/ pi 2))
    (progn
    (setq ang1 pi
  ang2 (* pi 1.25)
  ang3 (* pi 0.75)
  flag 1
 
  ))
    (progn
    (setq ang1 0
  ang2 (* pi 1.75)
  ang3 (* pi 0.25)
  flag -1
  )))
 
  (setq pt1 (polar spt ang1 8.)
pt2 (polar ept ang2 (/ 8. (sin (* pi 0.25)))))
(if (equal spa ept 0.00001)
    (setq pt3 epa)
    (setq pt3 spa)
  )
  (setq pl (vlax-invoke acsp 'AddPolyline (apply 'append (list pt1 pt2 pt3 ept spt))))
  (vlax-put pl 'Closed :vlax-true)
  (setq bul2 (MeCalcBulge (/ (+ (- rad 8.) rad) 2)
      (distance pt2 pt3) nil))
  (vla-setbulge pl 1 (* flag bul2))
  (vla-setbulge pl 2 (* flag bul1))

  (setq acmCol (vla-getinterfaceobject
(vlax-get-acad-object)
"AutoCAD.AcCmColor.16"))
  (vla-put-colorindex acmCol 8)
  (vla-put-truecolor pl acmCol)
  (vla-update pl)
  (setq plen (vlax-vla-object->ename pl))
  (vl-cmdf "-bhatch" "_S" plen "" "P" "SOLID" "")
  )
  (princ "There are too many objects ...")
  )
  (mapcar (function (lambda (x)      
(vl-catch-all-apply
  (function (lambda ()
  (progn
  (vla-delete pl)
(vlax-release-object x)))))))
  (list pl acmCol))
  (princ)
  )

~'J'~

[GDF]

Wow, thank you Fatty and Jurg.....this one is even better.

Thank you.

Gary

[Fatty]

Wow, thank you Fatty and Jurg.....this one is even better.

Thank you.

Gary

You are welcome,
but I didn't test it enough...

~'J'~