Author Topic: How to make parts of the side view in the current coordinates?  (Read 8801 times)

0 Members and 1 Guest are viewing this topic.

2e4lite

  • Guest
How to make parts of the side view in the current coordinates?
« on: November 20, 2013, 09:52:37 AM »
How to make parts of the side view in the current coordinates?

ronjonp

  • Needs a day job
  • Posts: 7526
Re: How to make parts of the side view in the current coordinates?
« Reply #1 on: November 20, 2013, 10:08:23 AM »
A little more info is needed ...

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

RC

  • Guest
Re: How to make parts of the side view in the current coordinates?
« Reply #2 on: November 20, 2013, 10:45:42 AM »
Assuming a 2D orthographic projection??  (If it's 3D its already in current coordinates)

Use UCS and adjust the origin such that the geometry reflects it's relative coordinates.

2e4lite

  • Guest
Re: How to make parts of the side view in the current coordinates?
« Reply #3 on: December 10, 2013, 07:00:14 AM »
    Use the following routine can make on the left side of the graph, If the graph is inclined, how to change the  routine can also make the right part?
   
Code - Auto/Visual Lisp: [Select]
  1.  (defun c:rs (/ cst dx dy msg n oce oqz osm pfa pfa1 poi tdate txtn txtnn x x1 x2 y y1 y2 qz VDa)
  2.    (setq OSM (getvar "OSMODE"))
  3.    (setvar "cmdecho" 0)
  4.    (setvar "OSMODE" 0)
  5.    (if (not $qz) (setq $qz 50))
  6.    (if (not $VDa)(setq $VDa 20))
  7.    (setq qz (getreal (strcat "\n height<" (rtos $qz 2 2) ">:"))
  8.          VDa(getreal (strcat "\n space" (rtos $VDa 2 2) ">:")))
  9.   (if (= qz nil) (setq qz $qz)(setq $qz qz))
  10.   (if (= VDa nil) (setq VDa $VDa)(setq $VDa VDa))
  11.    (c:bv)
  12.    (setq txtnn (ssget "L"))
  13.    (setq txtn (ssname txtnn 0))
  14.    (setq tdate (entget txtn))
  15.    (command "erase" txtnn "")
  16.    (setq x (list (cadr (assoc '10 tdate))))
  17.    (setq y (list (caddr (assoc '10 tdate))))
  18.    (foreach n  tdate
  19.       (if (= 10 (car n))
  20.     (progn   (setq x1 (list (cadr n)))
  21.       (setq x (append x x1))
  22.       (setq y1 (list (caddr n)))
  23.       (setq y (append y y1)))))
  24.    (setq x1 (car (vl-sort x '>)))
  25.    (setq x2 (car (vl-sort x '<)))
  26.    (setq y1 (car (vl-sort y '>)))
  27.    (setq y2 (car (vl-sort y '<)))
  28.    (setq dx (- x1 x2))
  29.    (setq dy (- y1 y2))
  30.    (initget 1)
  31.    (setq pfa (list x2 (- Y2 VDa)))
  32.    (setq pfa1 (mapcar '+ pfa (list dx (- 0 qz))))
  33.    (command "ucs" "w")
  34.    (command "RECTANG" pfa pfa1)
  35.    (initget "Yes No")
  36.    (setq cst (getkword "\n Whether to creat the right view? (Yes or No)<Yes>"))
  37.    (if (= cst nil)
  38.       (setq cst "Yes"))
  39.    (if (= cst "Yes")
  40.       (progn (setq pfa (list (+ x1 VDa) y1))
  41.         (setq pfa1 (mapcar '- pfa (list (- 0 qz) dy)))
  42.         (command "ucs" "w")
  43.         (command "RECTANG" pfa pfa1)))
  44.    (setvar "OSMODE" OSM)
  45.    (setvar "cmdecho" 1)(princ))

<edit: code tags added>
« Last Edit: December 10, 2013, 09:26:19 AM by CAB »

2e4lite

  • Guest
Re: How to make parts of the side view in the current coordinates?
« Reply #4 on: December 13, 2013, 12:06:11 AM »
Who can help me to reply the question? thanks!

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: How to make parts of the side view in the current coordinates?
« Reply #5 on: December 13, 2013, 12:53:06 AM »
What is this?
(c:bv)
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

2e4lite

  • Guest
Re: How to make parts of the side view in the current coordinates?
« Reply #6 on: December 13, 2013, 09:01:51 PM »
(defun c:bv(/ aa oos ptbox ptbl ptb2 x1 y1 x2 y2 aygetssboundbox ss1)
(defun aygetssboundbox   ( / i entname1 ptbox1 minpt maxpt ptlb ptrt)
   (setq i 0)
   (repeat (sslength ss1)
      (setq entname1 (ssname ss1 i))
      (vla-getboundingbox (vlax-ename->vla-object entname1) 'ptlb 'ptrt)
      (setq ptlb (vlax-safearray->list ptlb))
      (setq ptrt (vlax-safearray->list ptrt))
      (if (= minpt nil)
    (setq minpt ptlb)
    (progn
       (if   (> (car minpt) (car ptlb))
          (setq minpt (list (car ptlb) (cadr minpt))))
       (if   (> (cadr minpt) (cadr ptlb))
          (setq minpt (list (car minpt) (cadr ptlb)))))

    )

      (if (= maxpt nil)
    (setq maxpt ptrt)
    (progn ;else
       (if   (< (car maxpt) (car ptrt))
          (setq maxpt (list (car ptrt) (cadr maxpt))))
       (if   (< (cadr maxpt) (cadr ptrt))
          (setq maxpt (list (car maxpt) (cadr ptrt)))))
   
    )
   
      (setq i (+ i 1)))

   (if (<= (distance minpt maxpt) 0.0)
      (setq ptbox nil)
      (setq ptbox (list minpt maxpt)))
   )
  (setvar "cmdecho" 0)
  (setq oos (getvar "osmode"))
  (setvar "osmode" 0)
  (command "UCS" "w")
  (setvar "orthomode" 0)
  (setq aa (ssget))
  (setq ptbox (aygetssboundbox aa))
  (setq x1 (caar ptbox)
        y1 (cadar ptbox)
        x2 (caadr ptbox)
        y2 (cadadr ptbox))
  (setq ptbl (list x1 y1))
  (setq ptb2 (list x2 y2))
  (command "rectang" ptbl ptb2)
  (setvar "osmode" oos)
  (setvar "cmdecho" 1)
  (princ)
)
« Last Edit: December 27, 2013, 03:37:59 AM by 2e4lite »

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: How to make parts of the side view in the current coordinates?
« Reply #7 on: December 13, 2013, 09:44:59 PM »






kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: How to make parts of the side view in the current coordinates?
« Reply #8 on: December 13, 2013, 09:49:23 PM »
If so :

I think the easiest way will be to set the UCS to the object you are working with.

This will require some translations from world to current ucs.
//--------------
Another option is to temporarily copy-rotate the objects ( in code ) , do the views, then rotate the views and erase the copy.
Personally, I'd do the UCS translation method.
//--------------

With your code :
I'd break it up into several functions and add a few comments ( not many) to make your intention easier to determine.
« Last Edit: December 13, 2013, 09:53:21 PM by Kerry »
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

2e4lite

  • Guest
Re: How to make parts of the side view in the current coordinates?
« Reply #9 on: December 13, 2013, 09:57:41 PM »



Yeah,You understand correctly.Can you change the program to achieve this result.
« Last Edit: December 15, 2013, 12:32:36 AM by 2e4lite »

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: How to make parts of the side view in the current coordinates?
« Reply #10 on: December 13, 2013, 09:59:47 PM »



Yeah,You understand correctly.Can change the program to achieve this result.
 

Do you mean :
Can I ?
or
Can you?

I don't have time to play at the moment.

If I was writing the program, I'd allow the user to select the view direction ( just a thought )
This could be a very useful routine .. I hope you are able to complete it to your satisfaction.
« Last Edit: December 13, 2013, 10:03:11 PM by Kerry »
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: How to make parts of the side view in the current coordinates?
« Reply #11 on: December 14, 2013, 02:10:06 AM »
I had an hour or so to spare ...

Something like this:

View My Video
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: How to make parts of the side view in the current coordinates?
« Reply #12 on: December 14, 2013, 02:14:07 AM »
Have a play ...
Set the UCS to suit the object
Source file attached at the end of this post.

Code - Auto/Visual Lisp: [Select]
  1. ;; codehimbelonga kdub@theSwamp 2013.12.14
  2.  
  3. ;; Add comments to suit.
  4.  
  5. (defun c:sv (/           *error*     _getinput   _drawlower  _drawright
  6.              _drawleft   _drawtop    ss          la          corners
  7.             )
  8. ;;; -------------------------------------------------------------------------- ;
  9. ;;;
  10.   ;;------standard error trap------------------
  11.   (defun *error* (msg /) (kb:on-error msg) (princ))
  12.   (kb:savesysvar
  13.     '(("cmdecho" 0) ("highlight" 1) ("cmddia" 0) ("osmode" (+ os_none)))
  14.   )
  15. ;;; -------------------------------------------------------------------------- ;
  16. ;;;
  17.   (defun _getinput ()
  18.     (or $height (setq $height 50.0))
  19.     (or $offset (setq $offset 200.0))
  20.     (and (setq ss (ssget))
  21.          (setq $height (kb:getreal "Height" $height 1 nil))
  22.          (setq $offset (kb:getreal "Spacing Offset" $offset 1 nil))
  23.          (setq corners (kb:get-ss-boundingbox ss)
  24.                corners (list (list (caar corners) (cadar corners))
  25.                              (list (caadr corners) (cadar corners))
  26.                              (list (caadr corners) (cadadr corners))
  27.                              (list (caar corners) (cadadr corners))
  28.                        )
  29.          )
  30.          (setq la (getvar "CLAYER"))
  31.     )
  32.   )
  33. ;;; -------------------------------------------------------------------------- ;
  34. ;;;
  35.   (defun _drawlower ()
  36.     (if (= "Yes" (kb:getword "Draw LOWER view [Yes/No]" "Yes" nil "Yes No"))
  37.       (kb:draw_lightweightpolyline
  38.         (list (mapcar '- (car corners) (list 0. (+ $offset $height)))
  39.               (mapcar '- (cadr corners) (list 0. (+ $offset $height)))
  40.               (mapcar '- (cadr corners) (list 0. $offset))
  41.               (mapcar '- (car corners) (list 0. $offset))
  42.         )
  43.         la
  44.         :vlax-true
  45.       )
  46.     )
  47.   )
  48. ;;; -------------------------------------------------------------------------- ;
  49. ;;;  
  50.   (defun _drawright ()
  51.     (if (= "Yes" (kb:getword "Draw RIGHT view [Yes/No]" "Yes" nil "Yes No"))
  52.       (kb:draw_lightweightpolyline
  53.         (list (mapcar '+ (cadr corners) (list $offset 0.))
  54.               (mapcar '+ (cadr corners) (list (+ $offset $height) 0.))
  55.               (mapcar '+ (caddr corners) (list (+ $offset $height) 0.))
  56.               (mapcar '+ (caddr corners) (list $offset 0.))
  57.         )
  58.         la
  59.         :vlax-true
  60.       )
  61.     )
  62.   )
  63. ;;; -------------------------------------------------------------------------- ;
  64. ;;;
  65.   (defun _drawleft ()
  66.     (if (= "Yes" (kb:getword "Draw LEFT view [Yes/No]" "Yes" nil "Yes No"))
  67.       (kb:draw_lightweightpolyline
  68.         (list (mapcar '- (car corners) (list (+ $offset $height) 0.))
  69.               (mapcar '- (car corners) (list $offset 0.))
  70.               (mapcar '- (cadddr corners) (list $offset 0.))
  71.               (mapcar '- (cadddr corners) (list (+ $offset $height) 0.))
  72.         )
  73.         la
  74.         :vlax-true
  75.       )
  76.     )
  77.   )
  78. ;;; -------------------------------------------------------------------------- ;
  79. ;;;
  80.   (defun _drawtop ()
  81.     (if (= "Yes" (kb:getword "Draw Top view [Yes/No]" "Yes" nil "Yes No"))
  82.       (kb:draw_lightweightpolyline
  83.         (list (mapcar '+ (cadddr corners) (list 0. $offset))
  84.               (mapcar '+ (caddr corners) (list 0. $offset))
  85.               (mapcar '+ (caddr corners) (list 0. (+ $offset $height)))
  86.               (mapcar '+ (cadddr corners) (list 0. (+ $offset $height)))
  87.         )
  88.         la
  89.         :vlax-true
  90.       )
  91.     )
  92.   )
  93. ;;; -------------------------------------------------------------------------- ;
  94. ;;;
  95.   (if (_getinput)
  96.     (progn (_drawlower) (_drawright) (_drawleft) (_drawtop))
  97.   )
  98.   ;;------------------------------
  99.   (*error* nil)
  100.   (princ)
  101. )
  102.  

Library Stuff
Code - Auto/Visual Lisp: [Select]
  1. ;;; -------------------------------------------------------------------------- ;
  2. ;;;
  3. (defun kb:protect-assign (symbollist)
  4.   (eval
  5.     (list 'pragma (list 'quote (list (cons 'protect-assign symbollist))))
  6.   )
  7. )
  8. (defun kb:unprotect-assign (symbollist)
  9.               (list 'quote (list (cons 'unprotect-assign symbollist)))
  10.         )
  11.   )
  12. )
  13. ;;; -------------------------------------------------------------------------- ;
  14. ;;;
  15. (setq *tempvarlist* (list 'os_none           'os_end
  16.                           'os_mid            'os_cen
  17.                           'os_nod            'os_qua
  18.                           'os_int            'os_ins
  19.                           'os_per            'os_tan
  20.                           'os_nea            'os_clear
  21.                           'os_app            'os_ext
  22.                           'os_par            'os_all
  23.                           'kglobal:acadapp   'kglobal:activedoc
  24.                           'kglobal:modelspace
  25.                           'kb:on-error       'kb:savesysvar
  26.                           'kb:restoresysvar  'kb:getreal
  27.                           'kb:getword        'kb:ss->objlist
  28.                           'ucs2wcsmatrix     'wcs2ucsmatrix
  29.                           'kb:get-ss-boundingbox
  30.                           'kb:draw_lightweightpolyline
  31.                          )
  32. )
  33. (kb:unprotect-assign *tempvarlist*)
  34. (setq os_none 0
  35.       os_end 1
  36.       os_mid 2
  37.       os_cen 4
  38.       os_nod 8
  39.       os_qua 16
  40.       os_int 32
  41.       os_ins 64
  42.       os_per 128
  43.       os_tan 256
  44.       os_nea 512
  45.       os_clear 1024
  46.       os_app 2048
  47.       os_ext 4096
  48.       os_par 8192
  49.       os_all 16383
  50. )
  51.  
  52. ;;; -------------------------------------------------------------------------- ;
  53. ;;;
  54.  
  55. (or kglobal:acadapp (setq kglobal:acadapp (vlax-get-acad-object)))
  56. (or kglobal:activedoc
  57.     (setq kglobal:activedoc (vla-get-activedocument kglobal:acadapp))
  58. )
  59. (or kglobal:modelspace
  60.     (setq kglobal:modelspace (vla-get-modelspace kglobal:activedoc))
  61. )
  62.  
  63. ;;; -------------------------------------------------------------------------- ;
  64. ;;;
  65.  
  66. (defun kb:on-error (msg / tmp)
  67.   ;;----- Cancel any Active Commands -------------------------------------
  68.   (while (< 0 (getvar "cmdactive")) (command))
  69.   (setvar "menuecho" 1)
  70.   (vla-endundomark kglobal:activedoc)
  71.   ;;----- Display error message if applicable _---------------------------
  72.   (cond ((not msg))
  73.         ((member (strcase msg t)
  74.                  '("console break" "function cancelled" "quit / exit abort")
  75.          )
  76.         )
  77.         ((princ
  78.            (strcat "\nApplication Error: " (itoa (getvar "errno")) " :- " msg)
  79.          )
  80.          ;;----- Display backtrace ------------------------------------------
  81.          (vl-bt)
  82.         )
  83.   )
  84.   (setvar "errno" 0)
  85.   ;;----- Release Bound Special Activex Objects --------------------------
  86.   (foreach varname kglobal:objectsbound
  87.     (if (= (type (setq tmp (vl-symbol-value varname))) 'vla-object)
  88.       (if (not (vlax-object-released-p tmp))
  89.         (vlax-release-object tmp)
  90.       )
  91.     )
  92.     (set varname nil)
  93.   )
  94.   ;;----- Reset System Variables from global list ------------------------
  95.   (foreach item kglobal:sysvarlist (setvar (car item) (cadr item)))
  96.   ;;
  97.   (setq kglobal:sysvarlist nil
  98.         kglobal:objectsbound nil
  99.   )
  100.   (princ)
  101. )
  102. ;;; -------------------------------------------------------------------------- ;
  103. ;;; change sysvar value and save its previous value
  104.  
  105. (defun kb:savesysvar (vars_list / generalvars)
  106.   (setq generalvars '(("CMDECHO" 0)                              ; save current and Turns off echoing
  107.                       ("expert")                                 ; save current value
  108.                       ("ORTHOMODE")                              ; save current value
  109.                       ("SNAPANG")                                ; save current value
  110.                       ("UCSICON")                                ; save current value
  111.                       ("SNAPMODE")                               ; save current value
  112.                       ("OSMODE")                                 ; save current value                                  
  113.                       ("PICKADD" 2)                              ; save current and  Turns on PICKADD. Shift-Pick to remove
  114.                       ("PICKAUTO" 1)                             ; save current and  Draws a selection window (for either a window or a crossing selection) automatically
  115.                       ("PICKBOX" 8)                              ; save current and  initial is 3. my default is 6
  116.                       ("INSUNITS" 0)                             ; save current and  Unspecified (No units)
  117.                       ("SORTENTS" 1)                             ; save current and  use selection Order to control
  118.                      )
  119.   )
  120.   (foreach item (append vars_list generalvars)
  121.     (setq kglobal:sysvarlist (cons (list (car item) (getvar (car item)))
  122.                                    kglobal:sysvarlist
  123.                              )
  124.     )
  125.     (if (cadr item)
  126.       (setvar (car item) (eval (cadr item)))
  127.     )
  128.   )
  129. )
  130. ;;; -------------------------------------------------------------------------- ;
  131. ;;; ( kb:restoresysvar )
  132. (defun kb:restoresysvar ()
  133.   (foreach item kglobal:sysvarlist (setvar (car item) (cadr item)))
  134.   (setq kglobal:sysvarlist nil)
  135.   (princ)
  136. )
  137. ;;; -------------------------------------------------------------------------- ;
  138. ;;;
  139. ;; kwb 20021103
  140. ;; Getreal with options
  141. ;; Arguments:
  142. ;; msg : The prompt string.
  143. ;; def : Value to return if response is <enter>.
  144. ;; bit   : initget bit
  145. ;; kwd : Initget keywords string.
  146. ;;
  147. ;; Note : Arguments may be set to nil
  148. ;; (kb:getreal nil nil nil nil)
  149.  
  150. ;| #lib.
  151. kb:getReal (<Promptmsg><Default><InitBit><KeyWordList>)
  152.  
  153. Revised Library : kwb 20051031
  154. 20051101 kwb : ESC test added.
  155. Build 2.0 :
  156.  
  157. (SETQ tmpVal (kb:getReal "Percentage of Load" 75.0 (+ 1 2 4) '("Default" "To-suit")))
  158. (SETQ tmpVal (kb:getReal nil nil nil nil))
  159. |;
  160.  
  161. (defun kb:getreal (promptmsg      default        initbit        keywordlist
  162.                    /              initstring     keywordstring  returnvalue
  163.                   )
  164.   (or initbit (setq initbit 0))
  165.   ;;------------------------------
  166.   (if keywordlist
  167.     (setq initstring    (substr
  168.                           (apply 'strcat
  169.                                  (mapcar '(lambda (item) (strcat " " item)) keywordlist)
  170.                           )
  171.                           2
  172.                         )
  173.           keywordstring (strcat " [" (vl-string-translate " " "/" initstring) "]")
  174.     )
  175.     (setq initstring ""
  176.           keywordstring ""
  177.     )
  178.   )
  179.   ;;------------------------------
  180.   (setq promptmsg (strcat "\n"
  181.                           (cond (promptmsg)
  182.                                 ("Specify Real Value")
  183.                           )
  184.                           keywordstring
  185.                           (if (and default (numberp default))
  186.                             (progn (setq initbit (logand initbit (~ 1)))
  187.                                    (strcat " << " (rtos default 2) " >>")
  188.                             )
  189.                             ""
  190.                           )
  191.                           ": "
  192.                   )
  193.   )
  194.   ;;------------------------------
  195.   (initget initbit initstring)
  196.         (setq returnvalue (vl-catch-all-apply 'getreal (list promptmsg)))
  197.       )
  198.     ;; ESC was pressed.
  199.     (setq returnvalue nil
  200.           default nil
  201.     )
  202.   )
  203.   (if returnvalue
  204.     returnvalue
  205.     default
  206.   )
  207. )
  208.  
  209. ;;; -------------------------------------------------------------------------- ;
  210. ;;;
  211. ;; kwb 20021103
  212. ;; Getword with options
  213. ;; Arguments:
  214. ;; msg : The prompt string.
  215. ;; def : Value to return if response is <enter>.
  216. ;; bit   : initget bit
  217. ;; kwd : Initget keywords string.
  218. ;;
  219. ;; Note : Arguments may be set to nil
  220. ;;
  221. ;; (kb:getword "Specify a dimension [Length/Width/Depth/Option]" "Option" nil "Length Width Depth Option")
  222.  
  223. ;; (kb:getword "Add Prefix to Dimension Text [Yes/No]" "No" nil "Yes No")
  224. ;;
  225. (defun kb:getword (msg def bit kwd / returnvalue)
  226.   (or bit (setq bit 1))
  227.   (if (and def (= (type def) 'str))
  228.     (setq msg (strcat "\n" msg " << " def " >>: ")
  229.           bit (logand bit (~ 1))                                 ; ~ (bitwise NOT)  drop the 1 bit if def used
  230.     )
  231.     (setq msg (strcat "\n" msg ": "))
  232.   )
  233.   (initget bit kwd)
  234.   (if (setq returnvalue (getkword msg))
  235.     returnvalue
  236.     def
  237.   )
  238. )
  239.  
  240. ;;; -------------------------------------------------------------------------- ;
  241. ;;
  242. (defun kb:ss->objlist (ss / returnval)
  243.   (if (and ss (< 0 (sslength ss)))
  244.     (setq returnval (mapcar 'vlax-ename->vla-object
  245.                             (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
  246.                     )
  247.     )
  248.   )
  249.   returnval
  250. )
  251.  
  252.  
  253. ;;; -------------------------------------------------------------------------- ;
  254. ;; transform objects from the UCS to the WCS
  255. ;; when result passed to vla-transformby
  256. ;; From gile@TheSwamp
  257. (defun ucs2wcsmatrix ()
  258.     (append
  259.       (mapcar
  260.         '(lambda (vector origin) (append (trans vector 1 0 t) (list origin)))
  261.         (list '(1 0 0) '(0 1 0) '(0 0 1))
  262.         (trans '(0 0 0) 0 1)
  263.       )
  264.       (list '(0 0 0 1))
  265.     )
  266.   )
  267. )
  268. ;;; -------------------------------------------------------------------------- ;
  269. ;; transform objects from the WCS to the UCS
  270. ;; when result passed to vla-transformby
  271. ;; From gile@TheSwamp
  272. (defun wcs2ucsmatrix ()
  273.     (append
  274.       (mapcar
  275.         '(lambda (vector origin) (append (trans vector 0 1 t) (list origin)))
  276.         (list '(1 0 0) '(0 1 0) '(0 0 1))
  277.         (trans '(0 0 0) 1 0)
  278.       )
  279.       (list '(0 0 0 1))
  280.     )
  281.   )
  282. )
  283. ;;; -------------------------------------------------------------------------- ;
  284. ;; Return the bounding box opposite corners of a selection set of objects
  285. ;; a list of 3D points representing lower-left and upper-right
  286. ;; expressed in the current UCS
  287. ;; From gile@TheSwamp
  288. (defun kb:get-ss-boundingbox (ss / obj ll ur ll-ptlist ur-ptlist)
  289.   (foreach obj (kb:ss->objlist ss)
  290.     (vla-transformby obj (ucs2wcsmatrix))
  291.     (vla-getboundingbox obj 'll 'ur)
  292.     (vla-transformby obj (wcs2ucsmatrix))
  293.     (setq ll-ptlist (cons (vlax-safearray->list ll) ll-ptlist)
  294.           ur-ptlist (cons (vlax-safearray->list ur) ur-ptlist)
  295.     )
  296.   )
  297.   (mapcar '(lambda (a b) (apply 'mapcar (cons a b)))
  298.           '(min max)
  299.           (list ll-ptlist ur-ptlist)
  300.   )
  301. )
  302.  
  303.  
  304. ;;; -------------------------------------------------------------------------- ;
  305. ;;;
  306. (defun kb:draw_lightweightpolyline
  307.        (vertexlist la closeflag / ucsznormal elev polyobj)
  308.   (setq ucsznormal (trans '(0 0 1) 1 0 t)
  309.         elev       (caddr (trans (car vertexlist) 1 ucsznormal))
  310.   )
  311.   (setq
  312.     polyobj (vlax-invoke kglobal:modelspace
  313.                          'addlightweightpolyline
  314.                          (apply 'append
  315.                                 (mapcar '(lambda (pt)
  316.                                            (setq pt (trans pt 1 ucsznormal))
  317.                                            (list (car pt) (cadr pt))
  318.                                          )
  319.                                         vertexlist
  320.                                 )
  321.                          )
  322.             )
  323.   )
  324.   (vla-put-elevation polyobj elev)
  325.   (if la
  326.     (vla-put-layer polyobj la)
  327.   )
  328.   (vla-put-normal polyobj (vlax-3d-point ucsznormal))
  329.   (vla-put-closed polyobj closeflag)
  330.   polyobj
  331. )
  332. ;;; -------------------------------------------------------------------------- ;
  333. ;;;
  334. (kb:protect-assign *tempvarlist*)
  335. (setq *tempvarlist* nil)
  336. ;;; -------------------------------------------------------------------------- ;
  337. ;;;
  338.  
« Last Edit: December 14, 2013, 02:26:07 AM by Kerry »
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

2e4lite

  • Guest
Re: How to make parts of the side view in the current coordinates?
« Reply #13 on: December 14, 2013, 06:07:32 AM »
 An error occurred:Application Error: 22 :- AutoCAD Set variable rejected: "PICKADD" 2

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: How to make parts of the side view in the current coordinates?
« Reply #14 on: December 14, 2013, 02:27:37 PM »
An error occurred:Application Error: 22 :- AutoCAD Set variable rejected: "PICKADD" 2
 


So, You are using a version of AutoCAD prior to 2011 ... would have been sensible for you to say so.

in (defun kb:savesysvar

edit 
("PICKADD" 2)

to be
("PICKADD" 1)
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.