Jump to content

Need help with dcl


pmxcad

Recommended Posts

ok , so you want to be able to select a camera symbol , dialog pops up with data and then you want to be able to change one or more of the options in the popup_list's and write this back to the block.

Link to comment
Share on other sites

  • Replies 52
  • Created
  • Last Reply

Top Posters In This Topic

  • pmxcad

    26

  • rlx

    24

  • BIGAL

    3

Top Posters In This Topic

Posted Images

Just a suggestion, there are 47 attributes in the block so a popup list may need strcat tagname and current value. "Articlecode Camera" as example, lots of atts are blank. Then pop a single entry dcl with current value the list dcl should pop again so choose another clicking cancel exits. 

 

image.png.1c8ba383bb7fb6f8567e5145248e0240.png

 

; test code
(setq obj (vlax-ename->vla-object (car  (entsel "Pick block "))))
(setq atts (vlax-invoke obj 'getattributes))
(if  (= (vla-get-hasattributes obj) :vlax-true)
  (progn
    (setq lst '())
    (foreach att atts
      (setq lst (cons (strcat (vla-get-tagstring att) "  " (vla-get-textstring att)) lst))
    )
  )
(alert "Block picked has no attributes ")
)

 

Lee has a nice select 1 list add to blank 2nd list that would allow multiple atts to be processed one after each other.

Edited by BIGAL
Link to comment
Share on other sites

I've changed quite a lot (hopefully not too much). Your last code suggests for osb to look for articlecode_10 attribute. Symbol I downloaded didn't have this so (mis)used acticlecode_09 for this so you would have to change that back. Spent most part of the weekend on the code , so did very little testing therefore  probably not bug-free yet but for now I want to spent the last couple of hours of my weekend doing something else like 🍺 or 🍷& 😴

 

🐉

Camera_PmxCad_18-Jul-2021.lsp

Edited by rlx
Link to comment
Share on other sites

Hallo Rlx, 

Routine returns an error message "cam error" "null string". Menu disappears immediately after clicking the block. If you disable the "check ok" part, dcl menu will show up but not work properly. When adjusting, for example, the lens and then "update", the entire text/menu line will be placed in the attribute instead of the article code. But the strange thing is when the check ok part turn active again, the dialog box does appear and only the attributes after the "lens" are filled in/adjusted.

It has indeed become a complicated routine. I made dozens of these dcl menus, using this camera routine. I'm not going to start editing these too. Engineers have to do with an "alert".

 

Regards,

 

Jaap

Link to comment
Share on other sites

Two most difficult things are trying to get into someones mind / logic and haven't done enough testing. Have only tested it once on the one symbol you posted. Most of the time when I make something for my colleagues I first test drive it for a couple of days or weeks to catch as many bugs as possible.

One thing I was expecing is when camera hasn't been properly filled in , routine doesn't forgive. Maybe have a look at this later but it was late sunday evening and my bucket was empty if you know what I mean 🤪

Link to comment
Share on other sites

rlx,
one question, is it possible in the list (setq Data '(
 apply variables or somehow rearrange the order?

 

arrange orde like:

	(if (= Att4 "LTC-9215/00")		(setq Mount '("Wall mount cable feed through 30cm" "Wall mount cable feed through 18cm" "J mount for camera housing 40cm" "Pole mount maststeun")))				
	(if (= Att4 "LTC-9215/00S")		(setq Mount '("Wall mount cable feed through 18cm" "J mount for camera housing 40cm" "Pole mount maststeun" "Wall mount cable feed through 30cm")))						
	(if (= Att4 "LTC-9219/01")		(setq Mount '("J mount for camera housing 40cm" "Pole mount maststeun" "Wall mount cable feed through 30cm" "Wall mount cable feed through 18cm")))				
	(if (= Att4 "LTC-9213-01")		(setq Mount "Pole mount maststeun" "Wall mount cable feed through 30cm" "Wall mount cable feed through 18cm" "J mount for camera housing 40cm")))

	(if (= Att4 "NDA-FMT-DOME")		(setq Mount '("Plafondmontageset" "L-vormige-wandmontagebeugel-voor-domecamera")))
	(if (= Att4 "NDA-LWMT-DOME")	(setq Mount '("L-vormige-wandmontagebeugel-voor-domecamera" "Plafondmontageset" )))

	(if (= Att4 "VDA-WMT-AODOME")	(setq Mount '("Wandmontage buitenhuis Combineer met LTC9213-01 voor paalmontage" "Maststeun")))
	(if (= Att4 "LTC9213/01")		(setq Mount '("Maststeun" "Wandmontage buitenhuis Combineer met LTC9213-01 voor paalmontage")))

 

list Data

    (setq Data '(

	;---------------------------------

	("Dinion 5000 Boxcam"
	("Varifocal SR Megapixel Lens 9 40mm IR corrected lens with 1.5" "Varifocal SR Megapixel Lens 2.7 13mm 0.5 sensor")
	("Wall mount cable feed through 30cm" "Wall mount cable feed through 18cm" "J mount for camera housing 40cm" "Pole mount maststeun")
	("Outdoor Housing" "Geen")
	("PoE-class-1" "FTP" "Fiber")
	("Data" "Geen")
	)
	;---------------------------------

	("Dinion 6000 Boxcam"
	("Varifocal SR Megapixel Lens 9 40mm IR corrected lens with 1.5" "Varifocal SR Megapixel Lens 2.7 13mm 0.5 sensor")
	("Wall mount cable feed through 30cm" "Wall mount cable feed through 18cm" "J mount for camera housing 40cm" "Pole mount maststeun")
	("Outdoor Housing" "Geen")
	("PoE-class-3" "FTP" "Fiber")
	("Data" "Geen")
	)
	;---------------------------------

	("Dinion 7000 Boxcam"
	("Varifocal SR Megapixel Lens 9 40mm IR corrected lens with 1.5" "Varifocal SR Megapixel Lens 2.7 13mm 0.5 sensor")
	("Wall mount cable feed through 30cm" "Wall mount cable feed through 18cm" "J mount for camera housing 40cm" "Pole mount maststeun")
	("Outdoor Housing" "Geen")
	("PoE-class-3" "FTP" "Fiber")
	("Data" "Geen")
	)
	;---------------------------------

	("Indoor Dome"
	("")
	("Plafondmontageset" "L-vormige-wandmontagebeugel-voor-domecamera")
	("")
	("PoE-class-2" "FTP" "Fiber")
	("Data" "Geen")
	)
	;---------------------------------

	("Outdoor Dome"
	("")
	("Wandmontage buitenhuis Combineer met LTC9213-01 voor paalmontage" "Maststeun")
	("")
	("PoE-class-2" "FTP" "Fiber")
	("Data" "Geen")
	)
	;---------------------------------

	)
	)

 

 

remove "Maak keuze" from list "Data" and alwijs enable "OK"

(defun chk_ok ()
	(mode_tile "accept" 0)
	);defun

 

I don't know if it's possible. Just a thought.
My knowledge of Lisp doesn't go that far.

 

 

Jaap

Link to comment
Share on other sites

Have done a little rewrite. At this time routine does little more than let you select a camera and display its info if it can. It's only meant to show you how to store some of the data in variables rather than a big list.

 

(defun c:PmxCam ( / old-err done dialog cam-block inp sel ent el dcl-fn camera-name
                    lens-list mount-list house-list cable-list osb-list
                    i-lens i-mount i-housing i-cable i-osb)


  ;;; init
  (setq old-err *error* *error* camera_err)
  
  (setq done nil dialog nil cam-block nil)
  (princ "\nSelect camera or press space for menu or any other key for exit")
  (while (not done)
    (setq inp (vl-catch-all-apply 'grread (list nil 8 0)))
    (if (vl-catch-all-error-p inp)
      (progn
        (princ "\nPmxCam cancelled")
        (setq done t)
      )
      (cond
        ;;; user pressed space : go directly to dialog
        ((equal inp '(2 32)) (setq done t dialog t))
        ;;; user pressed any other key
        ((= (car inp) 2) (setq done t))
        ;;; check if user selected a point and if so, is there a cam down-under
        ((and (vl-consp inp) (= (car inp) 3) (setq sel (ssget (cadr inp)))
              (setq ent (ssname sel 0)) (setq el (entget ent)))
         (cond
           ((not (= (cdr (assoc 0 el)) "INSERT"))
            (princ "\nSelected object is not a block insert"))
           ((not (= (cdr (assoc 2 el)) "U00031"))
            (princ "\nWrong block selected"))
           (t (setq cam-block ent done t))
         )
        )
      )
    )
  )
  (cond
    (dialog (alert "Start dialog"))
    (cam-block (get_cam_info (vlax-ename->vla-object cam-block)) (create_dcl) (start_dcl))
    (t (princ "\nHastalavista"))
  )
  (princ)
)

(vl-load-com)

(defun camera_err (s)
  (if (and dcl-fn (string-p dcl-fn) (setq dcl-fn (findfile dcl-fn))) (vl-catch-all-apply 'vl-file-delete (list dcl-fn)))
  (if dcl-fp (close dcl-fp))
  (setq *error* old-err)
  (gc)
)

(defun get_cam_info ( cam-obj / camera lens mount housing cable osb pos)
  ;;; get attributes (change "ARTICLECODE_09" to _10 for osb)
  (mapcar '(lambda (var att) (set var (gav cam-obj att)))
          '(camera lens mount housing cable osb)
          '("ARTICLECODE_01" "ARTICLECODE_06" "ARTICLECODE_07" "ARTICLECODE_08" "NETWERK" "ARTICLECODE_09")
  )

  ;;; find camera by article code
  (cond
    ;;; Dinion 5000 Boxcam
    ((eq camera "NBN-50022-C")
     (setq camera-name "Dinion 5000 Boxcam")
     (setq lens-list
            '("Varifocal SR Megapixel Lens 9 40mm IR corrected lens with 1.5"
              "Varifocal SR Megapixel Lens 2.7 13mm 0.5 sensor"))
     (setq mount-list
            '("Wall mount cable feed through 30cm" "Wall mount cable feed through 18cm"
              "J mount for camera housing 40cm" "Pole mount maststeun"))
     (setq house-list '("Outdoor Housing" "Geen"))
     (setq cable-list '("PoE-class-1" "FTP" "Fiber"))
     (setq osb-list '("Data" "Geen"))
    )
    
    ;;; "Dinion 6000 Boxcam"
    ((eq camera "NBN-63023-B")
     (setq camera-name "Dinion 6000 Boxcam")
     (setq lens-list
            '("Varifocal SR Megapixel Lens 9 40mm IR corrected lens with 1.5"
                 "Varifocal SR Megapixel Lens 2.7 13mm 0.5 sensor"))
     (setq mount-list
            '("Wall mount cable feed through 30cm" "Wall mount cable feed through 18cm"
              "J mount for camera housing 40cm" "Pole mount maststeun"))
     (setq house-list '("Outdoor Housing" "Geen"))
     (setq cable-list '("PoE-class-3" "FTP" "Fiber"))
     (setq osb-list '("Data" "Geen"))
    )
    
    ;;; Dinion 7000 Boxcam
    ((eq camera "NBN-73023-BA")
     (setq camera-name "Dinion 7000 Boxcam")
     (setq lens-list
            '("Varifocal SR Megapixel Lens 9 40mm IR corrected lens with 1.5"
              "Varifocal SR Megapixel Lens 2.7 13mm 0.5 sensor"))
     (setq mount-list
            '("Wall mount cable feed through 30cm" "Wall mount cable feed through 18cm"
              "J mount for camera housing 40cm" "Pole mount maststeun"))
     (setq house-list '("Outdoor Housing" "Geen"))
     (setq cable-list '("PoE-class-3" "FTP" "Fiber"))
     (setq osb-list '("Data" "Geen"))
    )

    ;;; Indoor Dome
    ((eq camera "NIN-50022-A3")
     (setq camera-name "Indoor Dome")
     (setq lens-list '(""))
     (setq mount-list '("Plafondmontageset" "L-vormige-wandmontagebeugel-voor-domecamera"))
     (setq house-list '(""))
     (setq cable-list '("PoE-class-2" "FTP" "Fiber"))
     (setq osb-list '("Data" "Geen"))
    )

    ;;; Outdoor Dome
    ((eq camera "NDN-50022-A3")
     (setq camera-name "Outdoor Dome")
     (setq lens-list '(""))
     (setq mount-list '("Plafondmontageset" "L-vormige-wandmontagebeugel-voor-domecamera"))
     (setq house-list '(""))
     (setq cable-list '("PoE-class-2" "FTP" "Fiber"))
     (setq osb-list '("Data" "Geen"))
    )

    ;;; UCO - Unidentified Camera Object
    (t
     (setq camera-name "Unknown")
     (setq lens-list '(""))
     (setq mount-list '(""))
     (setq house-list '(""))
     (setq cable-list '(""))
     (setq lens-list '(""))
     (setq osb-list '(""))
    )
  )

  ;;; now set (popup) list pointers
  (if (and lens (setq pos (vl-position lens lens-list))) (setq i-lens pos) (setq i-lens 0))
  (if (and mount (setq pos (vl-position mount mount-list))) (setq i-mount pos) (setq i-mount 0))
  (if (and housing (setq pos (vl-position housing house-list))) (setq i-housing pos) (setq i-housing 0))
  (if (and cable (setq pos (vl-position cable cable-list))) (setq i-cable pos) (setq i-cable 0))
  (if (and osb (setq pos (vl-position osb osb-list))) (setq i-osb pos) (setq i-osb 0))
  
  (princ)
)



;;; ---------- Create dcl ----------

(defun create_dcl  (/ dcl-fp)
  (if (setq dcl-fp (open (setq dcl-fn (vl-filename-mktemp "camera.dcl")) "w"))
    (mapcar
      '(lambda (x) (write-line x dcl-fp))
      '("camera :dialog {label=\" Unica Special Security Projects\";spacer_1;"
        ":boxed_row {width=75; fixed_width=true; label=\"Configuratie Camera\";"
          ":column {"
            "spacer_1;"
            ":text {label=\"Type\";}"
            ":text {label=\"Objectief\";}"
            ":text {label=\"Montage\";}"
            ":text {label=\"Behuizing\";}"
            ":text {label=\"Netwerk\";}"
            ":text {label=\"OSB\";}"
            "spacer_1;"
            "}"
          ":column {children_fixed_width=true;"
            "spacer_1;"
            ":popup_list {key=\"pl_camera\";width=24;}"
            "spacer;"
            ":popup_list {key=\"pl_lens\";width=60;}"
            "spacer;"
            ":popup_list {key=\"pl_mount\";width=60;}"
            "spacer;"
            ":popup_list {key=\"pl_housing\";width=24;}"
            "spacer;"
            ":popup_list {key=\"pl_cable\";width=24;}"
            "spacer;"
            ":popup_list {key=\"pl_osb\";width=24;}"
            "spacer;"
            "spacer_1;"
            "}"
        "}"
        "spacer_1;"
        ":column {:row {fixed_width=true;alignment=centered;"
           ":button {label=\"Update\";key=\"bt_update\";}spacer; ok_cancel;}}"
        "}"
       )
    )
  )
  (if dcl-fp (close dcl-fp))
  (gc)
) ;end create dcl


(defun update_dialog  ()
  (start_list "pl_camera")  (mapcar 'add_list (list camera-name) )         (end_list) (set_tile "pl_camera" "0")
  (start_list "pl_lens")    (mapcar 'add_list lens-list) (end_list) (set_tile "pl_lens" (itoa i-lens))
  (start_list "pl_mount")   (mapcar 'add_list mount-list) (end_list) (set_tile "pl_mount" (itoa i-mount))
  (start_list "pl_housing") (mapcar 'add_list house-list) (end_list) (set_tile "pl_housing" (itoa i-housing))
  (start_list "pl_cable")   (mapcar 'add_list cable-list) (end_list) (set_tile "pl_cable" (itoa i-cable))
  (start_list "pl_osb")     (mapcar 'add_list osb-list) (end_list) (set_tile "pl_osb" (itoa i-osb))
)

(defun start_dcl  (/ dcl drv)
  (if (and (< 0 (setq dcl (load_dialog dcl-fn))) (new_dialog "camera" dcl))
    (progn
      (update_dialog)
      (action_tile "pl_camera" "(setq i-camera (atoi $value))(update_dialog)")
      (action_tile "pl_lens" "(setq i-lens (atoi $value))(chk_ok)")
      (action_tile "pl_mount" "(setq i-mount (atoi $value))(chk_ok)")
      (action_tile "pl_housing" "(setq i-housing (atoi $value))(chk_ok)")
      (action_tile "pl_cable" "(setq i-cable (atoi $value))(chk_ok)")
      (action_tile "pl_osb" "(setq i-osb (atoi $value))(chk_ok)")
      (action_tile "accept" "(done_dialog 1)")
      (action_tile "cancel" "(done_dialog 0)")
      (action_tile "bt_update" "(done_dialog 2)")
      (setq drv (start_dialog))
      (unload_dialog dcl)
      (vl-file-delete dcl-fn)
    )
  )
  (cond
    ((= drv 0) (princ "\nGeannuleerd door gebruiker"))
    ((= drv 1) ) ;;; (show_camera_setup))
    ((= drv 2) ) ;;; (update_camera_block))
    (t (princ "\nOh chips..."))
  )
)

;;; get attibute value (vla version)
(defun gav (b a) (setq a (strcase a))
  (vl-some '(lambda (x)(if (= a (strcase (vla-get-tagstring x)))(vla-get-textstring x)))(vlax-invoke b 'getattributes)))

 

Thing is , once a camera is identified , so are its options. This means you can't change camera type after this point but you would be able to change one or more of the options (update button not working at this time though). So its important to know once camera type is set , would user need ability to change it?

 

 

Edited by rlx
Link to comment
Share on other sites

Just had some time to play with it. Still had to add "ARTICLECODE" for the camera. Indeed can't change the camera type and when selecting/adjust one of the other options, closes the menu. This routine seems to make sense to me. But remains a challenge.

 

'(camera lens mount housing cable osb)
          '( "ARTICLECODE" "ARTICLECODE_01" "ARTICLECODE_06" "ARTICLECODE_07" "ARTICLECODE_08" "NETWERK" "ARTICLECODE_09")

 

Jaap

Link to comment
Share on other sites

  • 2 weeks later...

Hi Rlx, it`s me again.


I've been messing around with the routine for a while.
And I've come a little further.
But I still have 2 challenges.
1. It does not update the block attributes.
2. I want to modify the start so that it uses previous selection and then run the routine.
I want to modify the original camera.lsp so that once you select the block, it looks at attribute "ARTICLECODE" to see if it is empty or contains data. If empty, continue with the camera.lsp, otherwise continue with the Camera_Update.lsp.
Hope you have some time to look at it.
There's no rush, vacation time.

Kind regards,
Jaap

Camera_Update.lsp

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...