Topic: Create command to draw an object..?

[CAB]

Yes those are the local variables.
This is just starter routine that needs some error traps.

[CAB]

This is what I had in mind.

Code: [Select]

;;  CAB @ TheSwamp.org 06/05/2008
(Defun C:SQR (/ SquareWidth RoundWidth Run ptBase ll lr ur ul um acDoc obj1 obj2
              err lyrobj LayerName
             )
  (vl-load-com)
  ;;  CAB 05/31/07
  (defun activespace (doc)
    (if (or (= acmodelspace (vla-get-activespace doc))
            (= :vlax-true (vla-get-mspace doc))
        )
      (vla-get-modelspace doc)
      (vla-get-paperspace doc)
    )
  )
  (defun MakePline (space point-list)
    (vlax-invoke space
                 'AddLightWeightPolyline
                 (apply 'append point-list) ; 2D point list
    )
  )
;;  returns nil if make failed
(defun MakeLayer (lyrname acDoc / lyrobj)
  (vl-load-com)
  (if
    (not
      (vl-catch-all-error-p
        (setq lyrobj
          (vl-catch-all-apply
              'vla-add
              (list (vla-get-layers acDoc) lyrname))
        )
      )
    )
    lyrobj
  )
)
 
  (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))

  ;;  Create the layer
  (if (setq lyrobj (MakeLayer "Equip" acDoc))
    (progn
      (vla-put-color lyrobj "123")
      (vlax-release-object lyrobj)
      (setq LayerName "Equip")
    )
  )

  (if
    (and
      (setq SquareWidth (getdist "\nEnter the Square Width: "))
      (setq RoundWidth (getdist "\nEnter the Round Width: "))
      (setq Run (getdist "\nEnter the lenght: "))
    )
     (progn
       ;;  draw the object at 0,0 as the base point at middle of
       ;;  the square end, then move to desired location.
       (setvar "plinewid" 0)
       (setq ptBase '(0 0)
             ll     (polar ptBase pi (/ SquareWidth 2.))
             lr     (polar ptBase 0.0 (/ SquareWidth 2.))
             um     (polar ptBase (/ pi 2) Run)
             ul     (polar um pi (/ RoundWidth 2.))
             ur     (polar um 0.0 (/ RoundWidth 2.))
       )
       (if (setq obj1 (MakePline (activespace acDoc) (list ll lr ur ul)))
         (progn
           (vla-put-Closed Obj1 :vlax-true)
           (and LayerName (vla-put-Layer Obj1 LayerName))
           ;;(vla-put-Closed PolObj :vlax-true)
           ;;(vla-put-Color PolObj AcYellow)
           ;;(vla-put-Linetype PolObj "HIDDEN")
           (if (setq obj2 (MakePline (activespace acDoc) (list ll um lr)))
             (progn
               (and LayerName (vla-put-Layer Obj2 LayerName))
               (vla-put-Color Obj2 AcWhite)
               (setq err (vl-catch-all-apply
                           'vl-cmdf
                           (list "_.move"
                                 (vlax-vla-object->ename obj1)
                                 (vlax-vla-object->ename obj2)
                                 "" "_non" ptBase pause))
               )

             )
           )
           (if (< (distance ptBase (getvar "lastpoint")) 0.000001)
             ;;  objects were not moved, so erase them
             (progn
               (and obj1 (vla-erase obj1))
               (and obj2 (vla-erase obj2))
             )
           )

         )
       )

     )
  )
  (princ)
)

[CAB]

Here is another version where you select the base point of the object.

Code: [Select]

;;  CAB @ TheSwamp.org 06/05/2008
(Defun C:SQR (/ SquareWidth RoundWidth Run ptBase ll lr ur ul um acDoc obj1 obj2
              err lyrobj LayerName pp activespace MakePline MakeLayer
             )
  (vl-load-com)
  ;;  CAB 05/31/07
  (defun activespace (doc)
    (if (or (= acmodelspace (vla-get-activespace doc))
            (= :vlax-true (vla-get-mspace doc))
        )
      (vla-get-modelspace doc)
      (vla-get-paperspace doc)
    )
  )
  (defun MakePline (space point-list)
    (vlax-invoke space
                 'AddLightWeightPolyline
                 (apply 'append point-list) ; 2D point list
    )
  )
;;  returns nil if make failed
(defun MakeLayer (lyrname acDoc / lyrobj)
  (vl-load-com)
  (if
    (not
      (vl-catch-all-error-p
        (setq lyrobj
          (vl-catch-all-apply
              'vla-add
              (list (vla-get-layers acDoc) lyrname))
        )
      )
    )
    lyrobj
  )
)
 
  (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))

  ;;  Create the layer
  (if (setq lyrobj (MakeLayer "Equip" acDoc))
    (progn
      (vla-put-color lyrobj "123")
      (vlax-release-object lyrobj)
      (setq LayerName "Equip")
    )
  )

  (if
    (and
      (setq SquareWidth (getdist "\nEnter the Square Width: "))
      (setq RoundWidth (getdist "\nEnter the Round Width: "))
      (setq Run (getdist "\nEnter the lenght: "))
    )
     (progn
       (initget "0 1 2 3 4 5")
       (cond
         ((setq pp (getkword "\nRef Point on Duct.[0=MB 1=LL 2=LR 3=UR 4=UL 5=UM]<0>")))
         ((setq pp "0"))
       )
       ;;  draw the object at 0,0 as the base point at middle of
       ;;  the square end, then move to desired location.
       (setvar "plinewid" 0)
       (setq ptBase '(0 0)
             ll     (polar ptBase pi (/ SquareWidth 2.))
             lr     (polar ptBase 0.0 (/ SquareWidth 2.))
             um     (polar ptBase (/ pi 2) Run)
             ul     (polar um pi (/ RoundWidth 2.))
             ur     (polar um 0.0 (/ RoundWidth 2.))
       )
       ;;  redefine pp as the pick point
       (setq pp (eval (cdr (assoc pp '(("0" . ptBase)("1" . ll)("2" . lr)
                                       ("3" . ur)("4" . ul)("5" . um))))))
       (if (setq obj1 (MakePline (activespace acDoc) (list ll lr ur ul)))
         (progn
           (vla-put-Closed Obj1 :vlax-true)
           (and LayerName (vla-put-Layer Obj1 LayerName))
           ;;(vla-put-Closed PolObj :vlax-true)
           ;;(vla-put-Color PolObj AcYellow)
           ;;(vla-put-Linetype PolObj "HIDDEN")
           (if (setq obj2 (MakePline (activespace acDoc) (list ll um lr)))
             (progn
               (and LayerName (vla-put-Layer Obj2 LayerName))
               (vla-put-Color Obj2 AcWhite)
               (vl-catch-all-apply
                           'vl-cmdf
                           (list "_.move"
                                 (vlax-vla-object->ename obj1)
                                 (vlax-vla-object->ename obj2)
                                 "" "_non" pp pause))
               (if (> (distance ptBase (getvar "lastpoint")) 0.001)
                 (vl-catch-all-apply
                           'vl-cmdf
                           (list "_.rotate"
                                 (vlax-vla-object->ename obj1)
                                 (vlax-vla-object->ename obj2)
                                 "" "_non" (getvar "lastpoint") pause))
               )

             )
           )
           (if (< (distance ptBase (getvar "lastpoint")) 0.000001)
             ;;  objects were not moved, so erase them
             (progn
               (and obj1 (vla-erase obj1))
               (and obj2 (vla-erase obj2))
             )
           )

         )
       )

     )
  )
  (princ)
)

[CECE_CAD]

Hey CAB...   With the one that you have the base point set to (0 0)

Code: [Select]

;;  draw the object at 0,0 as the base point at middle of
       ;;  the square end, then move to desired location.
       (setvar "plinewid" 0)
       (setq ptBase '(0 0)    <------  Can i change this to be upper left, like this : (setq ptBase '(ul)

?

[CECE_CAD]

By the way, the code works great.  Yeah, it would of taking me a long time to get this one...  Thank you, I was so stuck.

[CAB]

You're welcome.

If you wnat to move based on the ul change this

Code: [Select]

(list "_.move"
                                 (vlax-vla-object->ename obj1)
                                 (vlax-vla-object->ename obj2)
                                 "" "_non" [color=red]ptBase[/color] pause))To this

Code: [Select]

(list "_.move"
                                 (vlax-vla-object->ename obj1)
                                 (vlax-vla-object->ename obj2)
                                 "" "_non" [color=red]ul[/color]  pause))

[CECE_CAD]

Very nice...     that is perfect