1D PROJECTION

[exceed]

 

 

(vl-load-com)
(defun c:1DPRO ( / ss ssb baseline ang ssl ent obj box llp urp 
                midp objcopy boxrot llr urr lineresult 
                lineresult_start lineresult_end start_linept 
                end_linept l1 l2 ilp1 ilp2 mindistilp1 ilp1len
                1ilp1 distilp1 minilp1 mindistilp2 ilp2len
                1ilp2 distilp2 minilp2 )
  (princ "\n Select Object : ")
  (setq ss (ssget '((0 . "*LINE,CIRCLE,ARC,ELLIPSE"))))
  (setq ss3 ss)
  
  (setq ssbox (LM:ssboundingbox ss))
  (setq ssmid (mapcar '/ (mapcar '+ (car ssbox) (cadr ssbox)) '(2 2 2)))
  
  
  (princ "\n Select Base Axis Line (Only 1) : ")
  
  (setq ssb (ssget '((0 . "LINE"))))
  (setq baseline (vlax-ename->vla-object (ssname ssb 0)))
  
  (setq cpt (vlax-curve-getclosestpointto baseline ssmid))
  (setq cang (angle cpt ssmid))
  (setq ang (vlax-get-property baseline 'angle))
  ;(setq ang (getangle "\n input angle"))
  (if (> ang pi) (- ang pi))
  (setq ang (* ang -1))
  (setq slmang (+ (* -1 ang) (/ pi 2)))

  (setq ssl (sslength ss))
  (setq index 0)
  (setq shadowlines '())
  (repeat ssl
    (setq ent (ssname ss index))
    (setq obj (vlax-ename->vla-object ent))
    (setq objlay (vlax-get-property obj 'layer))
    (setq objcol (vlax-get-property obj 'color))
    (setq box (vla-getboundingbox obj 'll 'ur))
    (setq llp (vlax-safearray->list ll))
    (setq urp (vlax-safearray->list ur))
    (setq midp (vlax-3D-point (mapcar '/ (mapcar '+ llp urp) '(2 2 2))))
    (princ midp)
    (setq objcopy (vla-copy obj))
    (if (/= (rem ang pi) 0)
      (vla-rotate objcopy midp ang)
    )
    (setq boxrot (vla-getboundingbox objcopy 'llrot 'urrot))
    
    (setq llr (vlax-safearray->list llrot))
    (setq urr (vlax-safearray->list urrot))
    (setq urr (list (car urr) (cadr llr) (caddr urr)))

    (setq lineresult (vlax-ename->vla-object (entmakex (list (cons 0 "LINE") (cons 10 llr) (cons 11 urr)))))
    (if (/= (rem ang pi) 0)
      (vla-rotate lineresult midp (* ang -1))
    )
    (setq lineresult_start (vlax-safearray->list (vlax-variant-value (vlax-get-property lineresult 'startpoint))))
    (setq lineresult_end (vlax-safearray->list (vlax-variant-value (vlax-get-property lineresult 'endpoint))))

    (setq start_linept (vlax-curve-getclosestpointto baseline lineresult_start))
    (setq end_linept (vlax-curve-getclosestpointto baseline lineresult_end))
    (setq l1 (vlax-ename->vla-object (entmakex (list (cons 0 "LINE") (cons 10 lineresult_start) (cons 11 start_linept)))))
    (setq l2 (vlax-ename->vla-object (entmakex (list (cons 0 "LINE") (cons 10 lineresult_end) (cons 11 end_linept)))))

    (if (/= nil (vla-intersectwith l1 obj 1))
      (setq ilp1 (vlax-safearray->list (vlax-variant-value (vla-intersectwith l1 obj 1))))
      (setq ilp1 lineresult_start)
    )
    (if (/= nil (vla-intersectwith l2 obj 1))
      (setq ilp2 (vlax-safearray->list (vlax-variant-value (vla-intersectwith l2 obj 1))))  
      (setq ilp2 lineresult_end)
    )

 ;   (princ "\n ilp1 origin - ") (princ ilp1)
 ;   (princ "\n ilp2 origin - ") (princ ilp2)
    (setq mindistilp1 0)
    (setq ilp1len (length ilp1))
    (if (> ilp1len 5)
      (progn
        (repeat (/ ilp1len 3)
          (setq 1ilp1 (list (car ilp1) (cadr ilp1) (caddr ilp1)))
          (setq distilp1 (distance 1ilp1 start_linept))
          (if (= mindistilp1 0) 
            (progn
              (setq minilp1 1ilp1)
              (setq mindistilp1 distilp1)
            )
            (progn
              (if (< distilp1 mindistilp1)
                (progn
                  (setq minilp1 1ilp1)
                  (setq mindistilp1 distilp1)
                )
              )
            )
          )
          (setq ilp1 (cdddr ilp1))
        )
        (setq ilp1 minilp1)
        (PRINC ilp1)
      )
    )

    (setq mindistilp2 0)
    (setq ilp2len (length ilp2))
    (if (> ilp2len 5)
      (progn
        (repeat (/ ilp2len 3)
          (setq 1ilp2 (list (car ilp2) (cadr ilp2) (caddr ilp2)))
          (setq distilp2 (distance 1ilp2 end_linept))
          (if (= mindistilp2 0) 
            (progn
              (setq minilp2 1ilp2)
              (setq mindistilp2 distilp2)
            )
            (progn
              (if (< distilp2 mindistilp2)
                (progn
                  (setq minilp2 1ilp2)
                  (setq mindistilp2 distilp2)
                )
              )
            )
          )
          (setq ilp2 (cdddr ilp2))
        )
        (setq ilp2 minilp2)
      )
    )
  ; (princ "\n ilp1 - ")
  ; (princ ilp1)

  ; (princ "\n ilp2 - ")
  ; (princ ilp2)
    (vla-delete objcopy)
    (vla-delete lineresult)

    (vla-delete l1)
    (vla-delete l2)

    ;(setq l1 (vlax-ename->vla-object (entmakex (list (cons 0 "LINE") (cons 8 objlay) (cons 10 ilp1) (cons 11 start_linept) (cons 62 objcol) ))))
    ;(setq l2 (vlax-ename->vla-object (entmakex (list (cons 0 "LINE") (cons 8 objlay) (cons 10 ilp2) (cons 11 end_linept) (cons 62 objcol) ))))
    
    ;(setq l3 (vlax-ename->vla-object (entmakex (list (cons 0 "LINE") (cons 8 objlay) (cons 10 start_linept) (cons 11 end_linept) (cons 62 objcol) ))))
    (setq shadowlines (cons start_linept shadowlines))
    (setq shadowlines (cons end_linept shadowlines))
    (setq index (+ index 1))
  )
  (setq shadowlines (vl-sort shadowlines 
                                                '(lambda (x y) 
                                                   (if (eq (car x) (car y)) 
                                                     (< (cadr x) (cadr y))
                                                     (< (car x) (car y))
                                                   )
                                                 )
                                       )
  )
  ;(princ "\n shadow lines - ")
  ;(princ shadowlines)

  (setq sllen (length shadowlines))
  (setq slmidlist '())
  
  (repeat (- sllen 1)
    (setq minstack '())
    (setq slmidpt (mapcar '/ (mapcar '+ (car shadowlines) (cadr shadowlines)) '(2 2 2)))
    ;(setq slang (+ (/ pi 2) (angle (car shadowlines) (cadr shadowlines)) ))
    ;(setq slang2 (- (/ pi 2) (angle (car shadowlines) (cadr shadowlines)) ))
    (setq slmidlistraypt (polar slmidpt cang 10000000))
    ;(setq slmidlistraypt2 (polar slmidpt slang2 10000000))
    (setq rayman (vlax-ename->vla-object (entmakex (list (cons 0 "LINE") (cons 67 0) (cons 8 objlay) (cons 10 slmidpt) (cons 11 slmidlistraypt)))))
    ;(setq rayman (vlax-ename->vla-object (entmakex (list (cons 0 "LINE") (cons 67 0) (cons 8 objlay) (cons 10 slmidlistraypt2) (cons 11 slmidlistraypt)))))
    (setq index 0)
    (repeat (sslength ss3)
      (setq ent2 (ssname ss3 index))
      (setq obj2 (vlax-ename->vla-object ent2))
      (setq minintersect (LM:intersections rayman obj2 AcExtendNone))
      ;(princ "\n minintersect - ")
      ;(princ minintersect)
      (if (<= 1 (length minintersect))
        (progn
          (setq minintersectlen (length minintersect))
          (repeat minintersectlen
            (setq minstack (cons (list (car minintersect) obj2) minstack))
            (setq minintersect (cdr minintersect))
          )
        )
      )
      (setq index (+ index 1))
    )
    (setq diststack '())
   ; (princ "\n min stack - ")
   ; (princ minstack)
    (if (/= minstack '())
      (progn
        (setq minstacklen (length minstack))
        (repeat minstacklen
          (setq diststack (cons (list (distance (car (car minstack)) slmidpt) (cadr (car minstack))) diststack))
          (setq minstack (cdr minstack))
        )
        (setq diststack (vl-sort diststack '(lambda (x y) (< (car x) (car y))) ) ) 
        (setq slmidlist (cons (list (car shadowlines) slmidpt (car diststack) (cadr shadowlines)) slmidlist))
      )
    )
    (vla-delete rayman)
    (setq shadowlines (cdr shadowlines))
  )
  ;(princ "\n slmidlist - ")
  ;(princ slmidlist)
  (setq slmlen (length slmidlist))
  (setq index 0)
  (setq cleanuplist '())
  (repeat slmlen
    (setq result1 (nth index slmidlist))
    (setq stpt (car result1))
    (setq enpt (nth 3 result1))
    (setq stealobj (cadr (nth 2 result1)))
    (setq cleanuplist (cons (list stpt enpt (vlax-get-property stealobj 'layer) (vlax-get-property stealobj 'color)) cleanuplist))
    ;(setq resultfinal (entmakex (list (cons 0 "LINE") (cons 67 0) (cons 8 (vlax-get-property stealobj 'layer)) (cons 10 stpt) (cons 11 enpt) (cons 62 (vlax-get-property stealobj 'color)))))
    (setq index (+ index 1))
  )
  (setq lencllist (length cleanuplist))
  (setq flag 0)
  (repeat (- lencllist 1)
    (setq alist (car cleanuplist))
    (setq blist (cadr cleanuplist))
    (if (and (= (cadr alist) (car blist)) (= (caddr alist) (caddr blist)) (= (cadddr alist) (cadddr blist)))
      (progn
        (if (= flag 0)
          (progn
            (setq memorystartpoint (car alist))
            (setq flag 1)
          )
        )
      )
      (progn
        (if (= flag 1)
          (progn
            (setq resultfinal (entmakex (list (cons 0 "LINE") (cons 67 0) (cons 8 (caddr alist)) (cons 10 memorystartpoint) (cons 11 (cadr alist)) (cons 62 (cadddr alist)))))
            (setq flag 0)
          )
          (progn
            (setq resultfinal (entmakex (list (cons 0 "LINE") (cons 67 0) (cons 8 (caddr alist)) (cons 10 (car alist)) (cons 11 (cadr alist)) (cons 62 (cadddr alist)))))
          )
        )
      )
    )
    (setq cleanuplist (cdr cleanuplist))
  )
  (vla-delete baseline)
  (princ)
)

;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;;     mod - [int] acextendoption enum of intersectwith method

(defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
)

;; Selection Set Bounding Box  -  Lee Mac
;; Returns a list of the lower-left and upper-right WCS coordinates of a
;; rectangular frame bounding all objects in a supplied selection set.
;; sel - [sel] Selection set for which to return bounding box

(defun LM:ssboundingbox ( sel / idx llp ls1 ls2 obj urp )
    (repeat (setq idx (sslength sel))
        (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
        (if (and (vlax-method-applicable-p obj 'getboundingbox)
                 (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
            )
            (setq ls1 (cons (vlax-safearray->list llp) ls1)
                  ls2 (cons (vlax-safearray->list urp) ls2)
            )
        )
    )
    (if (and ls1 ls2)
        (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))
    )
)

 

This code was just for practice, and has a some problems.

you can see that the magenta color polyline is not converted properly.

I don't know why

 

 

[CyberAngel]

It looks like the code is okay and the magenta polyline is showing up in some places. Could the issue be drawing order? That is, the magenta polyline gets drawn first and then other items get drawn over it. It's there, you just can't see it.

[exceed]

The flow of this code is as follows:

 

1. Rotate each object upside down by the baseline angle.

 

2. After that, consider the baseline to be the horizontal line, and find the left and right end lines with get bounding box.

 

3. Find the upper left point and upper right point and draw a vertical line from there to the baseline.

 

4. Among the points where the line touches the object, find the point closest to the baseline.

 

5. After drawing a line from that line to the baseline, divide the section of the baseline by the closest point of the baseline.

 

6. Find the midpoint of the divided section, draw a line from there backwards to the object, and check whether the line intersects the object.

 

7. Find the nearest object, get the object's color and layer, and draw a line for that section.

 

Previously, I used ucs and flatten after 3d rotate or view rotation,

In order to process overlapping objects,

it was necessary to organize them according to their elevation values,

and I created it with the idea that it could be done horizontally.

 

Bounding boxes are also used to find endpoints in curved surfaces

such as ellipses, circles, and bulges.

 

 

 

I'll have to think about it some more.

thanks for reply

 

+

ah, i found my mistake.

just modifying

 

(repeat (- lencllist 1)

 

to

 

(repeat lencllist 

 

then it works.lol

Edited May 2 by exceed